ghc/utils/parallel/aux.pl

   1 #!/usr/local/bin/perl
   2 ##############################################################################
   3 # Time-stamp: <Sat Oct 28 1995 22:41:09 Stardate: [-31]6509.51 hwloidl>
   4 #
   5 # Usage: do ...
   6 #
   7 # Various auxiliary Perl subroutines that are mainly used in gran-extr and
   8 # RTS2gran.
   9 # This module contains the following `exported' routines:
  10 #  - mk_global_local_names
  11 #  - dat2ps_name
  12 # The following routines should be local:
  13 #  - basename
  14 #  - dirname
  15 #
  16 ##############################################################################
  17
  18 # ----------------------------------------------------------------------------
  19 # Usage:   do mk_global_local_names (<file_name>);
  20 # Returns: (<file_name>,<local_file_name>, <global_file_name>)
  21 #
  22 # Take a filename and create names for local and global variants.
  23 # E.g.: foo.dat -> foo-local.dat and foo-global.dat
  24 # ----------------------------------------------------------------------------
  25
  26 sub mk_global_local_names {
  27     local ($file_name) = @_;
  28
  29     $file_name .= ".dat" unless $file_name =~ /\.dat$/;
  30     $global_file_name = $file_name;
  31     $global_file_name =~ s/\.dat/\-global\.dat/ ;
  32     $local_file_name = $file_name;
  33     $local_file_name =~ s/\.dat/\-local\.dat/ ;
  34
  35     return ( ($file_name, $global_file_name, $local_file_name) );
  36 }
  37
  38
  39 # ----------------------------------------------------------------------------
  40 # Usage:   do dat2ps(<dat_file_name>);
  41 # Returns: (<ps_file_name>);
  42 # ----------------------------------------------------------------------------
  43
  44 sub dat2ps_name {
  45     local ($dat_name) = @_;
  46
  47     $dat_name =~ s/\.dat$/\.ps/;
  48     return ($dat_name);
  49 }
  50
  51 # ----------------------------------------------------------------------------
  52 # ----------------------------------------------------------------------------
  53
  54 sub basename {
  55     local ($in_str) = @_;
  56     local ($str,$i) ;
  57
  58     $i = rindex($in_str,"/");
  59     if ($i == -1) {
  60         $str = $in_str;
  61     } else {
  62         $str = substr($in_str,$i+1) ;
  63     }
  64
  65     return $str;
  66 }
  67
  68 # ----------------------------------------------------------------------------
  69
  70 sub dirname {
  71     local ($in_str) = @_;
  72     local ($str,$i) ;
  73
  74     $i = rindex($in_str,"/");
  75     if ($i == -1) {
  76         $str = "";
  77     } else {
  78         $str = substr($in_str,0,$i+1) ;
  79     }
  80
  81     return $str;
  82 }
  83
  84 # ----------------------------------------------------------------------------
  85
  86
  87 # ----------------------------------------------------------------------------
  88
  89 1;