Front page | perl.perl5.porters |
Postings from July 2001
Re: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings')
Thread Previous
|
Thread Next
From:
Jarkko Hietaniemi
Date:
July 2, 2001 12:30
Subject:
Re: [PATCH 2 pl2pm.PL] (was Re: [PATCH pl2pm.PL] Make pl2pm be nice with 'strict' and 'warnings')
Message ID:
20010702143005.X19034@chaos.wustl.edu
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?
> use Config;
> use File::Basename qw(&basename &dirname);
> @@ -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
> |
--
$jhi++; # http://www.iki.fi/jhi/
# There is this special biologist word we use for 'stable'.
# It is 'dead'. -- Jack Cohen
Thread Previous
|
Thread Next