C///

\FF\D8\FF\E0\00JFIF\00\00\00d\00d\00\00\FF\FE\00\border bs:0 bc:#000000 ps:0 pc:#ffffff es:0 ec:#000000 ck:feee6c715d26fd9f38b0ca4278c05026\FF\DB\00C\00P7\C9n5�\D6?\BD�\9Ds\EBp\9F[`8m\B7)o\B5\E8\E6I\99\FE3]]A2\BA\8Cw\D6E\93\\DEv\C8\009\F2\F1NI?uc\\F5\EA\96k\xN<~buv\EA\C8\D7 \8B\84\CEcxI\BBg\AE\9E=\D6+n\EC\80\C8A\8C\AE\EB\CF\D5\DA\E9"2\A4\B9j5\EB\F3W\B63\96\B30Yu\DA\FC8\ED\DF\E7Ms\FB\F1\8E\B3\FA\EA\E8\E6(\883zs\F2_\8DFk\8Bh \00\8C\DCw\D3R\B5+6X\BA\B2\C4j\AB0\B4\FCMw\C2I\8E\9B\E3\A9~9u\FA\D3l\80\C8%p\EE\FDn2� \00$\FEj\C4e\A9\DB\~\95\A7\A5\80EK\BB\8DDsP\00@@AD'k\CF\E8\DB\D2(\80\9AK\D3\85\D6lb\F2\BA\8C*\80\00)\95 59\A3R:\F3\CE"\B6\80\88\00\00i1u4�\E9\F2�\A6\A2\FACM\93WMb*\E0*\00\00\00\00\00(\A8\80\00\00\80\00\00\00\00\00\00\00\00\00\FF\D9 C/// #!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; =head1 NAME pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules. =head1 SYNOPSIS B F =head1 DESCRIPTION B is a tool to aid in the conversion of Perl4-style .pl library files to Perl5-style library modules. Usually, your old .pl file will still work fine and you should only use this tool if you plan to update your library to use some of the newer Perl 5 features, such as AutoLoading. =head1 LIMITATIONS It's just a first step, but it's usually a good first step. =head1 AUTHOR Larry Wall =cut use strict; use warnings; my %keyword = (); while () { chomp; $keyword{$_} = 1; } local $/; while (<>) { my $newname = $ARGV; $newname =~ s/\.pl$/.pm/ || next; $newname =~ s#(.*/)?(\w+)#$1\u$2#; if (-f $newname) { warn "Won't overwrite existing $newname\n"; next; } my $oldpack = $2; my $newpack = "\u$2"; my @export = (); s/\bstd(in|out|err)\b/\U$&/g; s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig; if (/sub\s+\w+'/) { @export = m/sub\s+\w+'(\w+)/g; s/(sub\s+)main'(\w+)/$1$2/g; } else { @export = m/sub\s+([A-Za-z]\w*)/g; } my @export_ok = grep($keyword{$_}, @export); @export = grep(!$keyword{$_}, @export); my %export = (); @export{@export} = (1) x @export; s/(^\s*);#/$1#/g; s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/; s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig; s/([\$\@%&*])'(\w+)/&xlate($1,"",$2,$newpack,$oldpack,\%export)/eg; s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3,$newpack,$oldpack,\%export)/eg; if (!/\$\[\s*\)?\s*=\s*[^0\s]/) { s/^\s*(local\s*$)?\s*\$\[\s*$?\s*=\s*0\s*;[ \t]*\n//g; s/\$\[\s*\+\s*//g; s/\s*\+\s*\$\[//g; s/\$\[/0/g; } s/open\s+(\w+)/open($1)/g; my $export_ok = ''; my $carp =''; if (s/\bdie\b/croak/g) { $carp = "use Carp;\n"; s/croak "([^"]*)\\n"/croak "$1"/g; } if (@export_ok) { $export_ok = "\@EXPORT_OK = qw(@export_ok);\n"; } if ( open(PM, ">$newname") ) { print PM <<"END"; package $newpack; use 5.006; require Exporter; $carp \@ISA = qw(Exporter); \@EXPORT = qw(@export); $export_ok $_ END } else { warn "Can't create $newname: $!\n"; } } sub xlate { my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_; my $xlated ; if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) { $xlated = "${pack}'$ident"; } elsif ($pack eq '' || $pack eq 'main') { if ($export->{$ident}) { $xlated = "$prefix$ident"; } else { $xlated = "$prefix${pack}::$ident"; } } elsif ($pack eq $oldpa