perl/os2/perl2cmd.pl
<<
>>
Prefs
   1# This will put installed perl files into some other location
   2# Note that we cannot put hashbang to be extproc to make Configure work.
   3
   4use Config;
   5use File::Compare;
   6
   7$dir = shift;
   8$dir =~ s|/|\\|g ;
   9$nowarn = 1, $dir = shift if $dir eq '-n';
  10
  11die <<EOU unless defined $dir and -d $dir;
  12usage:  $^X $0 [-n] directory-to-install
  13  -n    do not check whether the directory is not on path
  14EOU
  15
  16@path = split /;/, $ENV{PATH};
  17$idir = $Config{installbin};
  18$indir =~ s|\\|/|g ;
  19
  20my %seen;
  21
  22foreach $file (<$idir/*>) {
  23  next if $file =~ /\.(exe|bak)/i;
  24  $base = $file;
  25  $base =~ s/\.$//;             # just in case...
  26  $base =~ s|.*/||;
  27  $base =~ s|\.pl$||;
  28  #$file =~ s|/|\\|g ;
  29  warn "Clashing output name for $file, skipping" if $seen{$base}++;
  30  my $new = (-f "$dir/$base.cmd" ? '' : ' (new file)');
  31  print "Processing $file => $dir/$base.cmd$new\n";
  32  my $ext = ($new ? '.cmd' : '.tcm');
  33  open IN, '<', $file or warn, next;
  34  open OUT, '>', "$dir/$base$ext" or warn, next;
  35  my $firstline = <IN>;
  36  my $flags = '';
  37  $flags = $2 if $firstline =~ /^#!\s*(\S+)\s+-([^#]+?)\s*(#|$)/;
  38  print OUT "extproc perl -S$flags\n$firstline";
  39  print OUT $_ while <IN>;
  40  close IN or warn, next;
  41  close OUT or warn, next;
  42  chmod 0444, "$dir/$base$ext";
  43  next if $new;
  44  if (compare "$dir/$base$ext", "$dir/$base.cmd") {     # different
  45    chmod 0666, "$dir/$base.cmd";
  46    unlink "$dir/$base.cmd";
  47    rename "$dir/$base$ext", "$dir/$base.cmd";
  48  } else {
  49    chmod 0666, "$dir/$base$ext";
  50    unlink "$dir/$base$ext";
  51    print "...unchanged...\n";
  52  }
  53}
  54
  55
lxr.linux.no kindly hosted by Redpill Linpro AS, provider of Linux consulting and operations services since 1995.