| 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 | |
| 4 | use Config; |
| 5 | use File::Compare; |
| 6 | |
| 7 | $dir = shift; |
| 8 | $dir =~ s|/|\\|g ; |
| 9 | $nowarn = 1, $dir = shift if $dir eq '-n'; |
| 10 | |
| 11 | die <<EOU unless defined $dir and -d $dir; |
| 12 | usage: $^X $0 [-n] directory-to-install |
| 13 | -n do not check whether the directory is not on path |
| 14 | EOU |
| 15 | |
| 16 | @path = split /;/, $ENV{PATH}; |
| 17 | $idir = $Config{installbin}; |
| 18 | $indir =~ s|\\|/|g ; |
| 19 | |
| 20 | my %seen; |
| 21 | |
| 22 | foreach $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 | |