lib/OSspecific.pm

   1 package OSspecific;
   2 use Cwd;
   3 use Config;
   4 use strict;
   5 use Carp;
   6 use Carp qw(cluck);
   7 use File::Spec;
   8 use Cwd;
   9
  10 ## Change the appropriate "system" command below to reflect your
  11 ## NONMEM installation.
  12 my $ver5_unix = '/export/home/nmv/util/nmfe5';
  13 my $ver55_unix = '/export/home/nmv/util/nmfe55 -d -f -O';
  14 my $ver6_unix = '/export/home/nmvi/util/nmfe6';
  15 my $ver6_unix_spec = '/export/home/nmvi/util/nmfe -d -f -O';
  16 my $ver5_win32 = 'nmfe5';
  17 my $ver6_win32 = 'nmfe6';
  18
  19 sub unique_path {
  20     my $path = shift;
  21     my $start = shift;
  22     $start = defined $start ? $start : '.';
  23     unless( defined $path ){
  24         $path = "autopath";
  25     }
  26     my $i = 1;
  27     #$start =~ s/\/*$//;
  28     #$start =~ s/\\*$//;
  29
  30     opendir DIRHANDLE , $start or die "Unable to list directory $start\n";
  31     my @dir_list = readdir(DIRHANDLE);
  32     closedir DIRHANDLE;
  33     my $max = 0;
  34     foreach my $dir_or_file ( @dir_list ){
  35       if( $dir_or_file =~ /^$path(\d+)/ ){
  36         my $ending = $1;
  37         $max = $ending if( $ending > $max );
  38         $i++;
  39       }
  40     }
  41
  42     if( $i > $max ){
  43       $max = $i;
  44     } else {
  45       $max++;
  46     }
  47
  48     # find( { wanted => sub{ /^$path/ && $i++ }}, $start );
  49
  50     if( -e $start . '/' . $path . $max ){
  51         die "The directory ${start}${path}${max} is in the way.\n";
  52     }
  53     my ( $dir , $file ) = absolute_path($start . '/' . $path . $max, '');
  54     return $dir;
  55 }
  56
  57 sub absolute_path {
  58
  59   # path finding strategy:
  60
  61   # 1. If path is not given it is assumed to be the current working
  62   # directory. If it is not absolute, it is assumed to be relative to
  63   # the current working directory.
  64
  65   # 2. If filename is absolute, let that overide the directory
  66
  67   # 3. If the filename is relative, assume the path as base.
  68
  69   my $path = shift;
  70   my $file = shift;
  71
  72   $file = File::Spec -> canonpath($file);
  73
  74   if( defined $path ){
  75     $path = File::Spec -> canonpath($path);
  76     unless( File::Spec -> file_name_is_absolute( $path ) ){
  77       $path = File::Spec -> rel2abs($path);
  78     }
  79   } else {
  80     $path = getcwd;
  81   }
  82
  83   my ($path_volume,$path_directory, $path_file) = File::Spec -> splitpath( $path, 1 );
  84   my ($file_volume,$file_directory, $file_file) = File::Spec -> splitpath( $file );
  85
  86   my @path_directory = File::Spec -> splitdir( $path_directory );
  87   my @file_directory = File::Spec -> splitdir( $file_directory );
  88   my @directory;
  89
  90   if( File::Spec -> file_name_is_absolute( $file ) ){
  91     $path_volume = $file_volume;
  92     @directory = @file_directory;
  93   } else {
  94     @directory = (@path_directory, @file_directory);
  95   }
  96
  97   for( my $i = 0; $i < $#directory; $i++ ){
  98     if( $directory[$i] ne File::Spec -> updir() and $directory[$i+1] eq File::Spec -> updir() ){
  99       @directory = (@directory[0..$i-1], @directory[$i+2..$#directory]);
 100       $i = $i-2;
 101     }
 102   }
 103
 104   $path = File::Spec -> catpath( $path_volume, File::Spec -> catfile( @directory,'' ), '' );
 105
 106   return ($path, $file_file);
 107
 108 # Below is old non portable code. I keep it for fun :) Kill it if it
 109 # annoys you.
 110
 111   # Step 1. Make the pathname absolute.
 112
 113 #  if( defined $path ){
 114 #       if ( $Config{osname} eq 'MSWin32' ) {
 115 #         unless ( $path =~ /^\w\:[\\\/]/ ) {
 116 #             $path = getcwd() . '/' . $path;
 117 #         }
 118 #       } else { # Assume os == unix
 119 #         unless( $path =~ /^\// ) {
 120 #             $path = getcwd() . '/' . $path;
 121 #         }
 122 #      }
 123 #  } else {
 124 #    $path = cwd();
 125 #  }
 126   # Step 2. Find out if filename is absolute
 127
 128 #   if ( $Config{osname} eq 'MSWin32' ) {
 129 #       if( $file =~ /^\w\:[\\\/]/ ){
 130 #         $is_absolute = 1;
 131 #       } else {
 132 #         $is_absolute = 0;
 133 #       }
 134 #   } else { # Assume OS == unix
 135 #       if( $file =~ /^\// ){
 136 #         $is_absolute = 1;
 137 #       } else {
 138 #         $is_absolute = 0;
 139 #       }
 140 #   }
 141
 142 #  $path =~ s!\\!\/!g; # Flip slashes in path
 143
 144 #  $file =~ s!\\!\/!g; # Flip slashes in filename
 145
 146 #  unless( $path =~ /\/$/ ) { # append trailing slash
 147 #      $path .= '/';
 148 #  }
 149
 150 #  while( $path =~ /[^\/]*\/\.\.\// ){
 151 #      $path =~ s![^\/]*\/\.\.\/!!g; # remove relative dots
 152 #  }
 153 #  while( $file =~ /[^\/]*\/\.\.\//  ){
 154 #      $file =~ s![^\/\.]*\/\.\.\/!!g; # remove relative dots
 155 #  }
 156
 157 #   my $tmp = $file;
 158 #   $tmp =~ s![^\/]*$!!;
 159
 160 #   if( $is_absolute ){
 161 #       unless( $path eq $tmp ){
 162 #       debug -> warn( level   => 2,
 163 #                      message => "path differs from file: $path ne $tmp, using $tmp" );
 164 #       }
 165 #       $path = $file;
 166 #   } else {
 167 #       $path .= $file;
 168 #       while( $path =~ /[^\/]*\/\.\.\// ){
 169 #         $path =~ s!\/[^\/]*\/\.\.!!g;
 170 #       }
 171 #   }
 172
 173 #   $path =~ s!([^\/]*)$!!;
 174 #   $file = $1;
 175
 176 #   while( $path =~ m!\.\/! ){
 177 #       $path =~ s!\.\/!\/!; # remove singel dots
 178 #   }
 179
 180 #   while( $path =~ m!\/\/! ){
 181 #       $path =~ s!\/\/!\/!; # remove double slashes
 182 #   }
 183
 184 #  return ($path, $file);
 185 }
 186
 187 sub NM_command {
 188   my $version = shift;
 189   my $prio = shift;
 190   my $modelfile = shift;
 191   my $outfile = shift;
 192   my $silent = shift;
 193   my $nm_opts = "";
 194
 195   my $os = $Config{osname};
 196   my $command;
 197   my $shell = '';
 198   $os = 'linux' unless ( $os eq 'MSWin32' );
 199
 200   if( $os eq 'linux' ){
 201       ## Sometimes it is necessary to specify the shell under which NONMEM
 202       ## executes. The shell needs to know where nmfe5 is. Example for csh:
 203       #my $shell ='/bin/csh';
 204
 205       ## Change this line to specify the shell under which you want to
 206       ## run NONMEM:
 207
 208       # PP_TODO Should this be a config option?
 209       $shell ='';
 210   }
 211
 212   if ( $version eq '5' and $os eq 'linux' ) {
 213       $command = $ver5_unix;
 214   } elsif ( $version eq '55' and $os eq 'linux' ) {
 215       $command = $ver55_unix;
 216   } elsif ( $version eq '6' and $os eq 'linux' ) {
 217       $command = $ver6_unix;
 218 #      $nm_opts = '-d -f -O'
 219   } elsif ( $version eq '6_nmfe' and $os eq 'linux' ) {
 220       $command = $ver6_unix_spec;
 221 #      $nm_opts = '-d -f -O'
 222   } elsif ( $version eq '5' and $os eq 'MSWin32' ) {
 223       $command = "$ver5_win32 $modelfile $outfile";
 224   } elsif ( $version eq '6' and $os eq 'MSWin32' ) {
 225       $command = "$ver6_win32 $modelfile $outfile";
 226   } else {
 227       debug -> warn( level   => 1,
 228                      message => "Could not determine platform. Assuming standard UNIX" );
 229       ## You will have to specify the shell under which NONMEM
 230       ## executes. The shell needs to know where nmfe5 is.
 231       $shell = '/bin/csh -f';
 232       $command = $ver5_unix;
 233   }
 234
 235   $silent = $silent ? ">$silent" : '';
 236
 237   $command = "$shell nice -n $prio $command $nm_opts $modelfile $outfile $silent"
 238       if ( $os eq 'linux' );
 239
 240   debug -> warn( level   => 2,
 241                  message => "$command" );
 242   return $command;
 243 }
 244
 245 sub directory {
 246   my $file = shift;
 247   my @tmp;
 248   my $directory;
 249   if ( $Config{osname} eq 'MSWin32' ) {
 250     if( $file =~ /\\/ ){
 251       @tmp = split(/\\/, $file );
 252       $directory = join( "\\", @tmp[0..$#tmp-1] )."\\";
 253     } else {
 254       $directory = '.';
 255     }
 256   } else { # Assume OS == unix
 257     if( $file =~ /\// ){
 258       @tmp = split(/\//, $file );
 259       $directory = join( '/', @tmp[0..$#tmp-1] ).'/';
 260     } else {
 261       $directory = '.';
 262     }
 263   }
 264   return $directory;
 265 }
 266
 267 sub nopath {
 268   my $file = shift;
 269   my @tmp;
 270   my $nopath;
 271   if ( $Config{osname} eq 'MSWin32' ) {
 272     if( $file =~ /\\/ ){
 273       @tmp = split(/\\/, $file );
 274       $nopath = $tmp[$#tmp];
 275     } else {
 276       $nopath = $file;
 277     }
 278   } else { # Assume OS == unix
 279     if( $file =~ /\// ){
 280       @tmp = split(/\//, $file );
 281       $nopath = $tmp[$#tmp];
 282     } else {
 283       $nopath = $file;
 284     }
 285   }
 286   return $nopath;
 287 }
 288
 289
 290 sub slurp_file {
 291   my $file = shift;
 292   my @content = ();
 293   open ( FILE, $file );
 294   while ( <FILE> ) {
 295     if ( $Config{osname} eq 'MSWin32' ) {
 296       chomp;
 297       $_=$_."\r\n";
 298     } else {
 299       s/\r//;
 300     }
 301     push( @content, $_ );
 302   }
 303   close(FILE);
 304   return @content;
 305 }
 306 1;