Front page | perl.perl5.porters |
Postings from July 2001
Re: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nicewith 'strict' and 'warnings')
Thread Previous
From:
Jonathan Stowe
Date:
July 2, 2001 12:45
Subject:
Re: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nicewith 'strict' and 'warnings')
Message ID:
Pine.LNX.4.33.0107022042570.8640-100000@orpheus.gellyfish.com
On Mon, 2 Jul 2001, Jarkko Hietaniemi wrote:
> On Mon, Jul 02, 2001 at 07:17:21PM +0100, Jonathan Stowe wrote:
> > On Mon, 2 Jul 2001, Jonathan Stowe wrote:
> >
> > > 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
> > > :)
> > >
> >
> > That might be what I thought I was doing but it was a bunch of crap. Put
> > it down to the heat, the dust, the surfeit of beer at the weekend but I
> > totally misdiagnosed the problem based on what I was seeing :(
> >
> > Anyway here is one that *does* fix the bug :)
> >
> > Oh and I took the opportunity to update the list of keywords too.
> >
> > /J\
> >
> > --- utils/pl2pm.PL~ Mon Jul 2 10:56:54 2001
> > +++ utils/pl2pm.PL Mon Jul 2 18:59:36 2001
> > @@ -1,4 +1,4 @@
> > -#!/usr/local/bin/perl
> > +#!/usr/local/bin/per
>
> Huh?
>
You can put smoking crack down on the list of misdemeanours in my file ...
I nearly sent the same wrong patch again :(
This one *is* the one I intended.
--- utils/pl2pm.PL~ Mon Jul 2 10:56:54 2001
+++ utils/pl2pm.PL Mon Jul 2 20:37:48 2001
@@ -61,43 +61,50 @@
=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;
- if (/sub\s+main'/) {
- @export = m/sub\s+main'(\w+)/g;
+ 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;
}
- @export_ok = grep($keyword{$_}, @export);
+ 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)/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 +113,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 +136,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
@@ -159,6 +172,8 @@
CORE
DESTROY
END
+INIT
+CHECK
abs
accept
alarm
@@ -170,6 +185,7 @@
caller
chdir
chmod
+chomp
chop
chown
chr
@@ -201,6 +217,7 @@
eq
eval
exec
+exists
exit
exp
fcntl
@@ -260,10 +277,12 @@
listen
local
localtime
+lock
log
lstat
lt
m
+map
mkdir
msgctl
msgget
@@ -279,16 +298,21 @@
opendir
or
ord
+our
pack
package
pipe
pop
+pos
print
printf
+prototype
push
q
qq
+qr
quotemeta
+qu
qw
qx
rand
@@ -348,12 +372,15 @@
substr
symlink
syscall
+sysopen
sysread
+sysseek
system
syswrite
tell
telldir
tie
+tied
time
times
tr
--
Jonathan Stowe |
<http://www.gellyfish.com> | This space for rent
|
Thread Previous