4 use File::Basename qw(&basename &dirname);
6 # List explicitly here the variables you want Configure to
7 # generate. Metaconfig only looks for shell variables, so you
8 # have to mention them as if they were shell variables, not
9 # %Config entries. Thus you write
11 # to ensure Configure will look for $Config{startperl}.
13 # This forces PL files to create target in same directory as PL file.
14 # This is so that make depend always knows where to find PL derivatives.
16 $file = basename($0, '.PL');
17 $file .= '.com' if $^O eq 'VMS';
19 open OUT,">$file" or die "Can't create $file: $!";
21 print "Extracting $file (with variable substitutions)\n";
23 # In this section, perl variables will be expanded during extraction.
24 # You can use $Config{...} to use Configure variables.
26 print OUT <<"!GROK!THIS!";
28 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
29 if \$running_under_some_shell;
32 # In the following, perl variables are not expanded during extraction.
34 print OUT <<'!NO!SUBS!';
38 pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules.
46 B<pl2pm> is a tool to aid in the conversion of Perl4-style .pl
47 library files to Perl5-style library modules. Usually, your old .pl
48 file will still work fine and you should only use this tool if you
49 plan to update your library to use some of the newer Perl 5 features,
54 It's just a first step, but it's usually a good first step.
58 Larry Wall <larry@wall.org>
71 $newname =~ s/\.pl$/.pm/ || next;
72 $newname =~ s#(.*/)?(\w+)#$1\u$2#;
74 warn "Won't overwrite existing $newname\n";
80 print "$oldpack => $newpack\n" if $verbose;
82 s/\bstd(in|out|err)\b/\U$&/g;
83 s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
85 @export = m/sub\s+main'(\w+)/g;
86 s/(sub\s+)main'(\w+)/$1$2/g;
89 @export = m/sub\s+([A-Za-z]\w*)/g;
91 @export_ok = grep($keyword{$_}, @export);
92 @export = grep(!$keyword{$_}, @export);
93 @export{@export} = (1) x @export;
95 s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
96 s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
97 s/([\$\@%&*])'(\w+)/&xlate($1,"",$2)/eg;
98 s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3)/eg;
99 if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
100 s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
105 s/open\s+(\w+)/open($1)/g;
107 if (s/\bdie\b/croak/g) {
108 $carp = "use Carp;\n";
109 s/croak "([^"]*)\\n"/croak "$1"/g;
115 $export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
121 open(PM, ">$newname") || warn "Can't create $newname: $!\n";
127 \@ISA = qw(Exporter);
128 \@EXPORT = qw(@export);
135 local($prefix, $pack, $ident) = @_;
136 if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
139 elsif ($pack eq "" || $pack eq "main") {
140 if ($export{$ident}) {
144 "$prefix${pack}::$ident";
147 elsif ($pack eq $oldpack) {
148 "$prefix${newpack}::$ident";
151 "$prefix${pack}::$ident";
384 close OUT or die "Can't close $file: $!";
385 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
386 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';