Front page | perl.perl5.porters |
Postings from July 2001
[PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings'
Thread Next
From:
Jonathan Stowe
Date:
July 2, 2001 03:16
Subject:
[PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings'
Message ID:
Pine.LNX.4.33.0107021103480.28391-100000@orpheus.gellyfish.com
I'm almost certain that no-one uses pl2pm anymore but lest anyone should
look at it as an example I have fixed it to use 'strict' and 'warnings' -
and generally had a bit of a cleanup. It does appear that it has had a
long standing bug which can be evidenced by running the current version
against ftp.pl in the distribution - I have fixed the symptom of the bug
:)
Have fun.
/J\
--- utils/pl2pm.PL~ Mon Jul 2 10:56:54 2001
+++ utils/pl2pm.PL Mon Jul 2 10:57:39 2001
@@ -61,25 +61,29 @@
=cut
+use strict;
+use warnings;
+
+my %keyword = ();
+
while (<DATA>) {
- chop;
+ chomp;
$keyword{$_} = 1;
}
-undef $/;
-$* = 1;
+local $/;
+
while (<>) {
- $newname = $ARGV;
+ 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;
}
- $oldpack = $2;
- $newpack = "\u$2";
- @export = ();
- print "$oldpack => $newpack\n" if $verbose;
+ 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;
@@ -90,14 +94,18 @@
else {
@export = m/sub\s+([A-Za-z]\w*)/g;
}
- @export_ok = grep($keyword{$_}, @export);
+ my @export_ok = grep($keyword{$_}, @export);
@export = grep(!$keyword{$_}, @export);
+
+ my %export = ();
@export{@export} = (1) x @export;
+ @export = keys %export;
+
s/(^\s*);#/$1#/g;
s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
- s/([\$\@%&*])'(\w+)/&xlate($1,"",$2)/eg;
- s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3)/eg;
+ 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;
@@ -106,24 +114,22 @@
}
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;
}
- else {
- $carp = "";
- }
+
if (@export_ok) {
$export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
}
- else {
- $export_ok = "";
- }
- open(PM, ">$newname") || warn "Can't create $newname: $!\n";
- print PM <<"END";
+ if ( open(PM, ">$newname") ) {
+ print PM <<"END";
package $newpack;
-require 5.000;
+require 5.6.0;
require Exporter;
$carp
\@ISA = qw(Exporter);
@@ -131,27 +137,35 @@
$export_ok
$_
END
+ }
+ else {
+ warn "Can't create $newname: $!\n";
+ }
}
sub xlate {
- local($prefix, $pack, $ident) = @_;
+ my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_;
+
+ my $xlated ;
if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
- "${pack}'$ident";
+ $xlated = "${pack}'$ident";
}
- elsif ($pack eq "" || $pack eq "main") {
- if ($export{$ident}) {
- "$prefix$ident";
+ elsif ($pack eq '' || $pack eq 'main') {
+ if ($export->{$ident}) {
+ $xlated = "$prefix$ident";
}
else {
- "$prefix${pack}::$ident";
+ $xlated = "$prefix${pack}::$ident";
}
}
elsif ($pack eq $oldpack) {
- "$prefix${newpack}::$ident";
+ $xlated = "$prefix${newpack}::$ident";
}
else {
- "$prefix${pack}::$ident";
+ $xlated = "$prefix${pack}::$ident";
}
+
+ return $xlated;
}
__END__
AUTOLOAD
--
Jonathan Stowe |
<http://www.gellyfish.com> | This space for rent
|
Thread Next
-
[PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings'
by Jonathan Stowe