| 1 | package Tk::install; |
| 2 | require Exporter; |
| 3 | |
| 4 | use vars qw($VERSION @EXPORT); |
| 5 | $VERSION = '3.012'; # $Id: //depot/Tk8/Tk/install.pm#12 $ |
| 6 | |
| 7 | use base qw(Exporter); |
| 8 | @EXPORT = qw(installbin); |
| 9 | |
| 10 | use Config; |
| 11 | |
| 12 | sub installbin |
| 13 | { |
| 14 | my $prog = shift(@ARGV); |
| 15 | my $start = $Config{'startperl'}; |
| 16 | my $perl = $Config{'perl'} || 'perl'; |
| 17 | $start =~ s/$perl$/$prog/; |
| 18 | while (($src,$dst) = splice(@ARGV,0,2)) |
| 19 | { |
| 20 | open(SRC,"<$src") || die "Cannot open $src:$!"; |
| 21 | my $line = <SRC>; |
| 22 | $line =~ s/^#!\s*\S+/$start/; |
| 23 | warn $line; |
| 24 | chmod(0755,$dst) if (-f $dst); |
| 25 | open(DST,">$dst") || die "Cannot open $dst:$!"; |
| 26 | print "installbin $src => $dst\n"; |
| 27 | do |
| 28 | { |
| 29 | print DST $line; |
| 30 | } while (defined($line = <SRC>)); |
| 31 | close(SRC); |
| 32 | close(DST); |
| 33 | chmod(0555,$dst); |
| 34 | } |
| 35 | } |
| 36 | |
| 37 | 1; |