Commit | Line | Data |
---|---|---|
86530b38 AT |
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; |