1*0Sstevel@tonic-gate#!/usr/local/bin/perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateuse Config; 4*0Sstevel@tonic-gateuse File::Basename qw(&basename &dirname); 5*0Sstevel@tonic-gateuse Cwd; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gate# List explicitly here the variables you want Configure to 8*0Sstevel@tonic-gate# generate. Metaconfig only looks for shell variables, so you 9*0Sstevel@tonic-gate# have to mention them as if they were shell variables, not 10*0Sstevel@tonic-gate# %Config entries. Thus you write 11*0Sstevel@tonic-gate# $startperl 12*0Sstevel@tonic-gate# to ensure Configure will look for $Config{startperl}. 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gate# This forces PL files to create target in same directory as PL file. 15*0Sstevel@tonic-gate# This is so that make depend always knows where to find PL derivatives. 16*0Sstevel@tonic-gate$origdir = cwd; 17*0Sstevel@tonic-gatechdir dirname($0); 18*0Sstevel@tonic-gate$file = basename($0, '.PL'); 19*0Sstevel@tonic-gate$file .= '.com' if $^O eq 'VMS'; 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateopen OUT,">$file" or die "Can't create $file: $!"; 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gateprint "Extracting $file (with variable substitutions)\n"; 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate# In this section, perl variables will be expanded during extraction. 26*0Sstevel@tonic-gate# You can use $Config{...} to use Configure variables. 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gateprint OUT <<"!GROK!THIS!"; 29*0Sstevel@tonic-gate$Config{startperl} 30*0Sstevel@tonic-gate eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' 31*0Sstevel@tonic-gate if \$running_under_some_shell; 32*0Sstevel@tonic-gate!GROK!THIS! 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate# In the following, perl variables are not expanded during extraction. 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gateprint OUT <<'!NO!SUBS!'; 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate=head1 NAME 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gatepl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules. 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate=head1 SYNOPSIS 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gateB<pl2pm> F<files> 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate=head1 DESCRIPTION 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gateB<pl2pm> is a tool to aid in the conversion of Perl4-style .pl 49*0Sstevel@tonic-gatelibrary files to Perl5-style library modules. Usually, your old .pl 50*0Sstevel@tonic-gatefile will still work fine and you should only use this tool if you 51*0Sstevel@tonic-gateplan to update your library to use some of the newer Perl 5 features, 52*0Sstevel@tonic-gatesuch as AutoLoading. 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate=head1 LIMITATIONS 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateIt's just a first step, but it's usually a good first step. 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate=head1 AUTHOR 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gateLarry Wall <larry@wall.org> 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate=cut 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gateuse strict; 65*0Sstevel@tonic-gateuse warnings; 66*0Sstevel@tonic-gate 67*0Sstevel@tonic-gatemy %keyword = (); 68*0Sstevel@tonic-gate 69*0Sstevel@tonic-gatewhile (<DATA>) { 70*0Sstevel@tonic-gate chomp; 71*0Sstevel@tonic-gate $keyword{$_} = 1; 72*0Sstevel@tonic-gate} 73*0Sstevel@tonic-gate 74*0Sstevel@tonic-gatelocal $/; 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gatewhile (<>) { 77*0Sstevel@tonic-gate my $newname = $ARGV; 78*0Sstevel@tonic-gate $newname =~ s/\.pl$/.pm/ || next; 79*0Sstevel@tonic-gate $newname =~ s#(.*/)?(\w+)#$1\u$2#; 80*0Sstevel@tonic-gate if (-f $newname) { 81*0Sstevel@tonic-gate warn "Won't overwrite existing $newname\n"; 82*0Sstevel@tonic-gate next; 83*0Sstevel@tonic-gate } 84*0Sstevel@tonic-gate my $oldpack = $2; 85*0Sstevel@tonic-gate my $newpack = "\u$2"; 86*0Sstevel@tonic-gate my @export = (); 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate s/\bstd(in|out|err)\b/\U$&/g; 89*0Sstevel@tonic-gate s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig; 90*0Sstevel@tonic-gate if (/sub\s+\w+'/) { 91*0Sstevel@tonic-gate @export = m/sub\s+\w+'(\w+)/g; 92*0Sstevel@tonic-gate s/(sub\s+)main'(\w+)/$1$2/g; 93*0Sstevel@tonic-gate } 94*0Sstevel@tonic-gate else { 95*0Sstevel@tonic-gate @export = m/sub\s+([A-Za-z]\w*)/g; 96*0Sstevel@tonic-gate } 97*0Sstevel@tonic-gate my @export_ok = grep($keyword{$_}, @export); 98*0Sstevel@tonic-gate @export = grep(!$keyword{$_}, @export); 99*0Sstevel@tonic-gate 100*0Sstevel@tonic-gate my %export = (); 101*0Sstevel@tonic-gate @export{@export} = (1) x @export; 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate s/(^\s*);#/$1#/g; 104*0Sstevel@tonic-gate s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/; 105*0Sstevel@tonic-gate s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig; 106*0Sstevel@tonic-gate s/([\$\@%&*])'(\w+)/&xlate($1,"",$2,$newpack,$oldpack,\%export)/eg; 107*0Sstevel@tonic-gate s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3,$newpack,$oldpack,\%export)/eg; 108*0Sstevel@tonic-gate if (!/\$\[\s*\)?\s*=\s*[^0\s]/) { 109*0Sstevel@tonic-gate s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g; 110*0Sstevel@tonic-gate s/\$\[\s*\+\s*//g; 111*0Sstevel@tonic-gate s/\s*\+\s*\$\[//g; 112*0Sstevel@tonic-gate s/\$\[/0/g; 113*0Sstevel@tonic-gate } 114*0Sstevel@tonic-gate s/open\s+(\w+)/open($1)/g; 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gate my $export_ok = ''; 117*0Sstevel@tonic-gate my $carp =''; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gate if (s/\bdie\b/croak/g) { 121*0Sstevel@tonic-gate $carp = "use Carp;\n"; 122*0Sstevel@tonic-gate s/croak "([^"]*)\\n"/croak "$1"/g; 123*0Sstevel@tonic-gate } 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate if (@export_ok) { 126*0Sstevel@tonic-gate $export_ok = "\@EXPORT_OK = qw(@export_ok);\n"; 127*0Sstevel@tonic-gate } 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate if ( open(PM, ">$newname") ) { 130*0Sstevel@tonic-gate print PM <<"END"; 131*0Sstevel@tonic-gatepackage $newpack; 132*0Sstevel@tonic-gateuse 5.006; 133*0Sstevel@tonic-gaterequire Exporter; 134*0Sstevel@tonic-gate$carp 135*0Sstevel@tonic-gate\@ISA = qw(Exporter); 136*0Sstevel@tonic-gate\@EXPORT = qw(@export); 137*0Sstevel@tonic-gate$export_ok 138*0Sstevel@tonic-gate$_ 139*0Sstevel@tonic-gateEND 140*0Sstevel@tonic-gate } 141*0Sstevel@tonic-gate else { 142*0Sstevel@tonic-gate warn "Can't create $newname: $!\n"; 143*0Sstevel@tonic-gate } 144*0Sstevel@tonic-gate} 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gatesub xlate { 147*0Sstevel@tonic-gate my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_; 148*0Sstevel@tonic-gate 149*0Sstevel@tonic-gate my $xlated ; 150*0Sstevel@tonic-gate if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) { 151*0Sstevel@tonic-gate $xlated = "${pack}'$ident"; 152*0Sstevel@tonic-gate } 153*0Sstevel@tonic-gate elsif ($pack eq '' || $pack eq 'main') { 154*0Sstevel@tonic-gate if ($export->{$ident}) { 155*0Sstevel@tonic-gate $xlated = "$prefix$ident"; 156*0Sstevel@tonic-gate } 157*0Sstevel@tonic-gate else { 158*0Sstevel@tonic-gate $xlated = "$prefix${pack}::$ident"; 159*0Sstevel@tonic-gate } 160*0Sstevel@tonic-gate } 161*0Sstevel@tonic-gate elsif ($pack eq $oldpack) { 162*0Sstevel@tonic-gate $xlated = "$prefix${newpack}::$ident"; 163*0Sstevel@tonic-gate } 164*0Sstevel@tonic-gate else { 165*0Sstevel@tonic-gate $xlated = "$prefix${pack}::$ident"; 166*0Sstevel@tonic-gate } 167*0Sstevel@tonic-gate 168*0Sstevel@tonic-gate return $xlated; 169*0Sstevel@tonic-gate} 170*0Sstevel@tonic-gate__END__ 171*0Sstevel@tonic-gateAUTOLOAD 172*0Sstevel@tonic-gateBEGIN 173*0Sstevel@tonic-gateCORE 174*0Sstevel@tonic-gateDESTROY 175*0Sstevel@tonic-gateEND 176*0Sstevel@tonic-gateINIT 177*0Sstevel@tonic-gateCHECK 178*0Sstevel@tonic-gateabs 179*0Sstevel@tonic-gateaccept 180*0Sstevel@tonic-gatealarm 181*0Sstevel@tonic-gateand 182*0Sstevel@tonic-gateatan2 183*0Sstevel@tonic-gatebind 184*0Sstevel@tonic-gatebinmode 185*0Sstevel@tonic-gatebless 186*0Sstevel@tonic-gatecaller 187*0Sstevel@tonic-gatechdir 188*0Sstevel@tonic-gatechmod 189*0Sstevel@tonic-gatechomp 190*0Sstevel@tonic-gatechop 191*0Sstevel@tonic-gatechown 192*0Sstevel@tonic-gatechr 193*0Sstevel@tonic-gatechroot 194*0Sstevel@tonic-gateclose 195*0Sstevel@tonic-gateclosedir 196*0Sstevel@tonic-gatecmp 197*0Sstevel@tonic-gateconnect 198*0Sstevel@tonic-gatecontinue 199*0Sstevel@tonic-gatecos 200*0Sstevel@tonic-gatecrypt 201*0Sstevel@tonic-gatedbmclose 202*0Sstevel@tonic-gatedbmopen 203*0Sstevel@tonic-gatedefined 204*0Sstevel@tonic-gatedelete 205*0Sstevel@tonic-gatedie 206*0Sstevel@tonic-gatedo 207*0Sstevel@tonic-gatedump 208*0Sstevel@tonic-gateeach 209*0Sstevel@tonic-gateelse 210*0Sstevel@tonic-gateelsif 211*0Sstevel@tonic-gateendgrent 212*0Sstevel@tonic-gateendhostent 213*0Sstevel@tonic-gateendnetent 214*0Sstevel@tonic-gateendprotoent 215*0Sstevel@tonic-gateendpwent 216*0Sstevel@tonic-gateendservent 217*0Sstevel@tonic-gateeof 218*0Sstevel@tonic-gateeq 219*0Sstevel@tonic-gateeval 220*0Sstevel@tonic-gateexec 221*0Sstevel@tonic-gateexists 222*0Sstevel@tonic-gateexit 223*0Sstevel@tonic-gateexp 224*0Sstevel@tonic-gatefcntl 225*0Sstevel@tonic-gatefileno 226*0Sstevel@tonic-gateflock 227*0Sstevel@tonic-gatefor 228*0Sstevel@tonic-gateforeach 229*0Sstevel@tonic-gatefork 230*0Sstevel@tonic-gateformat 231*0Sstevel@tonic-gateformline 232*0Sstevel@tonic-gatege 233*0Sstevel@tonic-gategetc 234*0Sstevel@tonic-gategetgrent 235*0Sstevel@tonic-gategetgrgid 236*0Sstevel@tonic-gategetgrnam 237*0Sstevel@tonic-gategethostbyaddr 238*0Sstevel@tonic-gategethostbyname 239*0Sstevel@tonic-gategethostent 240*0Sstevel@tonic-gategetlogin 241*0Sstevel@tonic-gategetnetbyaddr 242*0Sstevel@tonic-gategetnetbyname 243*0Sstevel@tonic-gategetnetent 244*0Sstevel@tonic-gategetpeername 245*0Sstevel@tonic-gategetpgrp 246*0Sstevel@tonic-gategetppid 247*0Sstevel@tonic-gategetpriority 248*0Sstevel@tonic-gategetprotobyname 249*0Sstevel@tonic-gategetprotobynumber 250*0Sstevel@tonic-gategetprotoent 251*0Sstevel@tonic-gategetpwent 252*0Sstevel@tonic-gategetpwnam 253*0Sstevel@tonic-gategetpwuid 254*0Sstevel@tonic-gategetservbyname 255*0Sstevel@tonic-gategetservbyport 256*0Sstevel@tonic-gategetservent 257*0Sstevel@tonic-gategetsockname 258*0Sstevel@tonic-gategetsockopt 259*0Sstevel@tonic-gateglob 260*0Sstevel@tonic-gategmtime 261*0Sstevel@tonic-gategoto 262*0Sstevel@tonic-gategrep 263*0Sstevel@tonic-gategt 264*0Sstevel@tonic-gatehex 265*0Sstevel@tonic-gateif 266*0Sstevel@tonic-gateindex 267*0Sstevel@tonic-gateint 268*0Sstevel@tonic-gateioctl 269*0Sstevel@tonic-gatejoin 270*0Sstevel@tonic-gatekeys 271*0Sstevel@tonic-gatekill 272*0Sstevel@tonic-gatelast 273*0Sstevel@tonic-gatelc 274*0Sstevel@tonic-gatelcfirst 275*0Sstevel@tonic-gatele 276*0Sstevel@tonic-gatelength 277*0Sstevel@tonic-gatelink 278*0Sstevel@tonic-gatelisten 279*0Sstevel@tonic-gatelocal 280*0Sstevel@tonic-gatelocaltime 281*0Sstevel@tonic-gatelock 282*0Sstevel@tonic-gatelog 283*0Sstevel@tonic-gatelstat 284*0Sstevel@tonic-gatelt 285*0Sstevel@tonic-gatem 286*0Sstevel@tonic-gatemap 287*0Sstevel@tonic-gatemkdir 288*0Sstevel@tonic-gatemsgctl 289*0Sstevel@tonic-gatemsgget 290*0Sstevel@tonic-gatemsgrcv 291*0Sstevel@tonic-gatemsgsnd 292*0Sstevel@tonic-gatemy 293*0Sstevel@tonic-gatene 294*0Sstevel@tonic-gatenext 295*0Sstevel@tonic-gateno 296*0Sstevel@tonic-gatenot 297*0Sstevel@tonic-gateoct 298*0Sstevel@tonic-gateopen 299*0Sstevel@tonic-gateopendir 300*0Sstevel@tonic-gateor 301*0Sstevel@tonic-gateord 302*0Sstevel@tonic-gateour 303*0Sstevel@tonic-gatepack 304*0Sstevel@tonic-gatepackage 305*0Sstevel@tonic-gatepipe 306*0Sstevel@tonic-gatepop 307*0Sstevel@tonic-gatepos 308*0Sstevel@tonic-gateprint 309*0Sstevel@tonic-gateprintf 310*0Sstevel@tonic-gateprototype 311*0Sstevel@tonic-gatepush 312*0Sstevel@tonic-gateq 313*0Sstevel@tonic-gateqq 314*0Sstevel@tonic-gateqr 315*0Sstevel@tonic-gatequotemeta 316*0Sstevel@tonic-gateqw 317*0Sstevel@tonic-gateqx 318*0Sstevel@tonic-gaterand 319*0Sstevel@tonic-gateread 320*0Sstevel@tonic-gatereaddir 321*0Sstevel@tonic-gatereadline 322*0Sstevel@tonic-gatereadlink 323*0Sstevel@tonic-gatereadpipe 324*0Sstevel@tonic-gaterecv 325*0Sstevel@tonic-gateredo 326*0Sstevel@tonic-gateref 327*0Sstevel@tonic-gaterename 328*0Sstevel@tonic-gaterequire 329*0Sstevel@tonic-gatereset 330*0Sstevel@tonic-gatereturn 331*0Sstevel@tonic-gatereverse 332*0Sstevel@tonic-gaterewinddir 333*0Sstevel@tonic-gaterindex 334*0Sstevel@tonic-gatermdir 335*0Sstevel@tonic-gates 336*0Sstevel@tonic-gatescalar 337*0Sstevel@tonic-gateseek 338*0Sstevel@tonic-gateseekdir 339*0Sstevel@tonic-gateselect 340*0Sstevel@tonic-gatesemctl 341*0Sstevel@tonic-gatesemget 342*0Sstevel@tonic-gatesemop 343*0Sstevel@tonic-gatesend 344*0Sstevel@tonic-gatesetgrent 345*0Sstevel@tonic-gatesethostent 346*0Sstevel@tonic-gatesetnetent 347*0Sstevel@tonic-gatesetpgrp 348*0Sstevel@tonic-gatesetpriority 349*0Sstevel@tonic-gatesetprotoent 350*0Sstevel@tonic-gatesetpwent 351*0Sstevel@tonic-gatesetservent 352*0Sstevel@tonic-gatesetsockopt 353*0Sstevel@tonic-gateshift 354*0Sstevel@tonic-gateshmctl 355*0Sstevel@tonic-gateshmget 356*0Sstevel@tonic-gateshmread 357*0Sstevel@tonic-gateshmwrite 358*0Sstevel@tonic-gateshutdown 359*0Sstevel@tonic-gatesin 360*0Sstevel@tonic-gatesleep 361*0Sstevel@tonic-gatesocket 362*0Sstevel@tonic-gatesocketpair 363*0Sstevel@tonic-gatesort 364*0Sstevel@tonic-gatesplice 365*0Sstevel@tonic-gatesplit 366*0Sstevel@tonic-gatesprintf 367*0Sstevel@tonic-gatesqrt 368*0Sstevel@tonic-gatesrand 369*0Sstevel@tonic-gatestat 370*0Sstevel@tonic-gatestudy 371*0Sstevel@tonic-gatesub 372*0Sstevel@tonic-gatesubstr 373*0Sstevel@tonic-gatesymlink 374*0Sstevel@tonic-gatesyscall 375*0Sstevel@tonic-gatesysopen 376*0Sstevel@tonic-gatesysread 377*0Sstevel@tonic-gatesysseek 378*0Sstevel@tonic-gatesystem 379*0Sstevel@tonic-gatesyswrite 380*0Sstevel@tonic-gatetell 381*0Sstevel@tonic-gatetelldir 382*0Sstevel@tonic-gatetie 383*0Sstevel@tonic-gatetied 384*0Sstevel@tonic-gatetime 385*0Sstevel@tonic-gatetimes 386*0Sstevel@tonic-gatetr 387*0Sstevel@tonic-gatetruncate 388*0Sstevel@tonic-gateuc 389*0Sstevel@tonic-gateucfirst 390*0Sstevel@tonic-gateumask 391*0Sstevel@tonic-gateundef 392*0Sstevel@tonic-gateunless 393*0Sstevel@tonic-gateunlink 394*0Sstevel@tonic-gateunpack 395*0Sstevel@tonic-gateunshift 396*0Sstevel@tonic-gateuntie 397*0Sstevel@tonic-gateuntil 398*0Sstevel@tonic-gateuse 399*0Sstevel@tonic-gateutime 400*0Sstevel@tonic-gatevalues 401*0Sstevel@tonic-gatevec 402*0Sstevel@tonic-gatewait 403*0Sstevel@tonic-gatewaitpid 404*0Sstevel@tonic-gatewantarray 405*0Sstevel@tonic-gatewarn 406*0Sstevel@tonic-gatewhile 407*0Sstevel@tonic-gatewrite 408*0Sstevel@tonic-gatex 409*0Sstevel@tonic-gatexor 410*0Sstevel@tonic-gatey 411*0Sstevel@tonic-gate!NO!SUBS! 412*0Sstevel@tonic-gate 413*0Sstevel@tonic-gateclose OUT or die "Can't close $file: $!"; 414*0Sstevel@tonic-gatechmod 0755, $file or die "Can't reset permissions for $file: $!\n"; 415*0Sstevel@tonic-gateexec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; 416*0Sstevel@tonic-gatechdir $origdir; 417