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