prj_install.pl

   1 #! /usr/bin/perl
   2 eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
   3     & eval 'exec perl -w -S $0 $argv:q'
   4     if 0;
   5
   6 # ******************************************************************
   7 #      Author: Chad Elliott
   8 # Create Date: 3/09/2004
   9 #         $Id$
  10 # ******************************************************************
  11
  12 # ******************************************************************
  13 # Pragma Section
  14 # ******************************************************************
  15
  16 use strict;
  17 use Cwd;
  18 use FileHandle;
  19 use File::Copy;
  20 use File::Basename;
  21
  22 # ******************************************************************
  23 # Data Section
  24 # ******************************************************************
  25
  26 my $insext   = 'ins';
  27 my $version  = '1.9';
  28 my %defaults = ('header_files'   => 1,
  29                 'idl_files'      => 1,
  30                 'inline_files'   => 1,
  31                 'pidl_files'     => 1,
  32                 'template_files' => 1,
  33                 'mpb_files'      => 1,
  34                );
  35
  36 my %special  = ('exe_output' => 1,
  37                 'lib_output' => 1,
  38                );
  39
  40 my %actual;
  41 my %base;
  42 my %override;
  43 my $keepgoing = 0;
  44
  45 eval 'symlink("", "");';
  46 my $hasSymlink = ($@ eq '');
  47
  48 # ******************************************************************
  49 # Subroutine Section
  50 # ******************************************************************
  51
  52 sub rm_updirs {
  53   my $path  = shift;
  54   my @parts = split(/[\/\\]/, $path);
  55
  56   ## Split the path into parts and check for '..'.  If we find one
  57   ## and the previous entry wasn't one, then we can remove them both.
  58   for(my $i = 0; $i <= $#parts; $i++) {
  59     if ($i > 0 && $parts[$i] eq '..' && $parts[$i - 1] ne '..') {
  60       splice(@parts, $i - 1, 2);
  61       $i -= 2;
  62     }
  63   }
  64   return join('/', @parts);
  65 }
  66
  67 sub copyFiles {
  68   my($files, $insdir, $symlink, $verbose) = @_;
  69   my $type = ($symlink ? 'link' : 'copy');
  70   my $cwd = getcwd();
  71
  72   foreach my $file (@$files) {
  73     my $dest = rm_updirs($insdir . '/' .
  74                          (defined $actual{$file} ?
  75                                  "$actual{$file}/" .
  76                                  basename($file) : $file));
  77     my $fulldir = dirname($dest);
  78     if (! -d $fulldir) {
  79       my $tmp = '';
  80       foreach my $part (split(/[\/\\]/, $fulldir)) {
  81         $tmp .= $part . '/';
  82         mkdir($tmp, 0755);
  83       }
  84     }
  85
  86     if (! -e $dest || (-M $file) < (-M $dest)) {
  87       if ($verbose) {
  88         print '', ($symlink ? 'Linking' : 'Copying'), " to $dest\n";
  89       }
  90       my $status;
  91       if ($symlink) {
  92         unlink($dest);
  93         $status = symlink("$cwd/$file", $dest);
  94       }
  95       else {
  96         $status = copy($file, $dest);
  97         chmod(0755, $dest) if ($status && -x $file);
  98       }
  99       if (!$status) {
 100         print STDERR "ERROR: Unable to $type $file to $dest\n";
 101         if (!$keepgoing) {
 102           return 0;
 103         }
 104       }
 105     }
 106     else {
 107       print "Skipping $file\n" if ($verbose);
 108     }
 109   }
 110   return 1;
 111 }
 112
 113
 114 sub determineSpecialName {
 115   my($tag, $dir, $info) = @_;
 116
 117   my($insdir, $name) = split(/\s+/, $info);
 118   if (defined $name) {
 119     $insdir .= '/';
 120   }
 121   else {
 122     $name = $insdir;
 123     $insdir = '';
 124   }
 125
 126   my $odir = ($dir eq '' ? '.' : $dir) . '/' . $insdir;
 127   if ($tag eq 'exe_output') {
 128     my @exes;
 129     my $fh   = new FileHandle();
 130     if (opendir($fh, $odir)) {
 131       foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
 132         if ($file =~ /^$name$/ ||
 133             $file =~ /^$name.*\.exe$/i) {
 134           push(@exes, "$dir$insdir$file");
 135         }
 136       }
 137       closedir($fh);
 138     }
 139     return @exes;
 140   }
 141   elsif ($tag eq 'lib_output') {
 142     my @libs;
 143     my $fh   = new FileHandle();
 144     if (opendir($fh, $odir)) {
 145       foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
 146         if ($file =~ /^lib$name\.(a|so|sl)/ ||
 147             $file =~ /^(lib)?$name.*\.(dll|lib)$/i) {
 148           push(@libs, "$dir$insdir$file");
 149         }
 150       }
 151       closedir($fh);
 152     }
 153     return @libs;
 154   }
 155
 156   return "$dir$name";
 157 }
 158
 159
 160 sub replaceVariables {
 161   my $line = shift;
 162   while($line =~ /(\$\(([^)]+)\))/) {
 163     my $whole = $1;
 164     my $name = $2;
 165     my $val = (defined $ENV{$name} ? $ENV{$name} : '');
 166     $line =~ s/\$\([^)]+\)/$val/;
 167   }
 168   return $line;
 169 }
 170
 171
 172 sub loadInsFiles {
 173   my($files, $tags, $verbose) = @_;
 174   my $fh = new FileHandle();
 175   my @copy;
 176
 177   foreach my $file (@$files) {
 178     if (open($fh, $file)) {
 179       if ($verbose) {
 180         print "Loading $file\n";
 181       }
 182       my $base = dirname($file);
 183       if ($base eq '.') {
 184         $base = '';
 185       }
 186       else {
 187         $base =~ s/^\.[\/\\]+//;
 188         $base .= '/';
 189       }
 190
 191       my $current;
 192       while(<$fh>) {
 193         my $line = $_;
 194         $line =~ s/^\s+//;
 195         $line =~ s/\s+$//;
 196
 197         if ($line ne '') {
 198           if ($line =~ /^(\w+):$/) {
 199             if (defined $$tags{$1}) {
 200               $current = $1;
 201             }
 202             else {
 203               $current = undef;
 204             }
 205           }
 206           elsif (defined $current) {
 207             $line = replaceVariables($line);
 208             my $start = $#copy + 1;
 209             if (defined $special{$current}) {
 210               push(@copy, determineSpecialName($current, $base, $line));
 211             }
 212             else {
 213               push(@copy, "$base$line");
 214             }
 215             if (defined $override{$current}) {
 216               for(my $i = $start; $i <= $#copy; ++$i) {
 217                 $actual{$copy[$i]} = $override{$current};
 218               }
 219             }
 220             elsif (defined $base{$current}) {
 221               for(my $i = $start; $i <= $#copy; ++$i) {
 222                 $actual{$copy[$i]} = $base{$current} . '/' .
 223                                      dirname($copy[$i]);
 224               }
 225             }
 226           }
 227         }
 228       }
 229       close($fh);
 230     }
 231     else {
 232       print STDERR "Unable to open $file\n";
 233       return ();
 234     }
 235   }
 236
 237   return @copy;
 238 }
 239
 240
 241 sub getInsFiles {
 242   my $file  = shift;
 243   my @files;
 244
 245   if (-d $file) {
 246     my $fh = new FileHandle();
 247     if (opendir($fh, $file)) {
 248       foreach my $f (grep(!/^\.\.?$/, readdir($fh))) {
 249         push(@files, getInsFiles("$file/$f"));
 250       }
 251       closedir($fh);
 252     }
 253   }
 254   elsif ($file =~ /\.$insext$/) {
 255     push(@files, $file);
 256   }
 257   return @files;
 258 }
 259
 260
 261 sub usageAndExit {
 262   my $msg = shift;
 263
 264   print STDERR "$msg\n" if (defined $msg);
 265
 266   my $base = basename($0);
 267   my $spc  = ' ' x (length($base) + 8);
 268   print STDERR "$base v$version\n",
 269                "Usage: $base [-a tag1[,tagN]] [-b tag=dir] ",
 270                ($hasSymlink ? '[-l] ' : ''), "[-o tag=dir]\n",
 271                $spc, "[-s tag1[,tagN]] [-v] [-k] [install directory]\n",
 272                $spc, "[$insext files or directories]\n\n",
 273                "Install files matching the tag specifications found ",
 274                "in $insext files.\n\n",
 275                "-a  Adds to the default set of tags that get copied.\n",
 276                "-b  Install tag into dir underneath the install directory.\n",
 277                "-k  Keep going if a file to be copied is missing.\n",
 278                ($hasSymlink ? "-l  Use symbolic links instead of copying.\n" : ''),
 279                "-o  Install tag into dir.\n",
 280                "-s  Sets the tags that get copied.\n",
 281                "-v  Enables verbose mode.\n",
 282                "\n",
 283                "The default set of tags are:\n";
 284   my $first = 1;
 285   foreach my $key (sort keys %defaults) {
 286     print STDERR '', ($first ? '' : ', '), $key;
 287     $first = 0;
 288   }
 289   print STDERR "\n";
 290
 291   exit(0);
 292 }
 293
 294 # ******************************************************************
 295 # Main Section
 296 # ******************************************************************
 297
 298 my $verbose;
 299 my $first = 1;
 300 my $insdir;
 301 my $symlink;
 302 my @insfiles;
 303 my %tags = %defaults;
 304
 305 for(my $i = 0; $i <= $#ARGV; ++$i) {
 306   my $arg = $ARGV[$i];
 307   if ($arg =~ /^-/) {
 308     if ($arg eq '-a') {
 309       ++$i;
 310       if (defined $ARGV[$i]) {
 311         foreach my $tag (split(',', $ARGV[$i])) {
 312           $tags{$tag} = 1;
 313         }
 314       }
 315       else {
 316         usageAndExit('-a requires a parameter.');
 317       }
 318     }
 319     elsif ($arg eq '-b') {
 320       ++$i;
 321       if (defined $ARGV[$i]) {
 322         if ($ARGV[$i] =~ /([^=]+)=(.*)/) {
 323           $base{$1} = $2;
 324         }
 325         else {
 326           usageAndExit("Invalid parameter to -b: $ARGV[$i]");
 327         }
 328       }
 329       else {
 330         usageAndExit('-b requires a parameter.');
 331       }
 332     }
 333     elsif ($arg eq '-k') {
 334       $keepgoing = 1;
 335     }
 336     elsif ($arg eq '-l') {
 337       $symlink = $hasSymlink;
 338     }
 339     elsif ($arg eq '-o') {
 340       ++$i;
 341       if (defined $ARGV[$i]) {
 342         if ($ARGV[$i] =~ /([^=]+)=(.*)/) {
 343           $override{$1} = $2;
 344         }
 345         else {
 346           usageAndExit("Invalid parameter to -o: $ARGV[$i]");
 347         }
 348       }
 349       else {
 350         usageAndExit('-o requires a parameter.');
 351       }
 352     }
 353     elsif ($arg eq '-s') {
 354       ++$i;
 355       if (defined $ARGV[$i]) {
 356         %tags = ();
 357         foreach my $tag (split(',', $ARGV[$i])) {
 358           $tags{$tag} = 1;
 359         }
 360       }
 361       else {
 362         usageAndExit('-s requires a parameter.');
 363       }
 364     }
 365     elsif ($arg eq '-v') {
 366       $verbose = 1;
 367     }
 368     else {
 369       usageAndExit('Unkown option: ' . $arg);
 370     }
 371   }
 372   elsif (!defined $insdir) {
 373     $arg =~ s/\\/\//g;
 374     $insdir = $arg;
 375   }
 376   else {
 377     if ($first) {
 378       $first = 0;
 379       if ($verbose) {
 380         print "Collecting $insext files...\n";
 381       }
 382     }
 383     $arg =~ s/\\/\//g;
 384     push(@insfiles, getInsFiles($arg));
 385   }
 386 }
 387
 388 if (!defined $insdir) {
 389   usageAndExit();
 390 }
 391 elsif (!defined $insfiles[0]) {
 392   print "No $insext files were found.\n";
 393   exit(1);
 394 }
 395
 396 my $status = 1;
 397 my @files  = loadInsFiles(\@insfiles, \%tags, $verbose);
 398 if (defined $files[0]) {
 399   $status = (copyFiles(\@files, $insdir, $symlink, $verbose) ? 0 : 1);
 400 }
 401
 402 exit($status);