This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.000
[perl5.git] / pl2pm
CommitLineData
a0d0e21e
LW
1#!/usr/bin/perl
2
3while (<DATA>) {
4 chop;
5 $keyword{$_} = 1;
6}
7
8undef $/;
9$* = 1;
10while (<>) {
11 $newname = $ARGV;
12 $newname =~ s/\.pl$/.pm/ || next;
13 $newname =~ s#(.*/)?(\w+)#$1\u$2#;
14 if (-f $newname) {
15 warn "Won't overwrite existing $newname\n";
16 next;
17 }
18 $oldpack = $2;
19 $newpack = "\u$2";
20 @export = ();
21 print "$oldpack => $newpack\n" if $verbose;
22
23 s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
24 if (/sub\s+main'/) {
25 @export = m/sub\s+main'(\w+)/g;
26 s/(sub\s+)main'(\w+)/$1$2/g;
27 }
28 else {
29 @export = m/sub\s+([A-Za-z]\w*)/g;
30 }
31 @export_ok = grep($keyword{$_}, @export);
32 @export = grep(!$keyword{$_}, @export);
33 @export{@export} = (1) x @export;
34 s/(^\s*);#/$1#/g;
35 s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
36 s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
37 s/([\$\@%&*])'(\w+)/&xlate($1,"",$2)/eg;
38 s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3)/eg;
39 if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
40 s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
41 s/\$\[\s*\+\s*//g;
42 s/\s*\+\s*\$\[//g;
43 s/\$\[/0/g;
44 }
45 s/open\s+(\w+)/open($1)/g;
46
47 if (s/\bdie\b/croak/g) {
48 $carp = "use Carp;\n";
49 s/croak "([^"]*)\\n"/croak "$1"/g;
50 }
51 else {
52 $carp = "";
53 }
54 if (@export_ok) {
55 $export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
56 }
57 else {
58 $export_ok = "";
59 }
60
61 open(PM, ">$newname") || warn "Can't create $newname: $!\n";
62 print PM <<"END";
63package $newpack;
64require 5.000;
65require Exporter;
66$carp
67\@ISA = qw(Exporter);
68\@EXPORT = qw(@export);
69$export_ok
70$_
71END
72}
73
74sub xlate {
75 local($prefix, $pack, $ident) = @_;
76 if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
77 "${pack}'$ident";
78 }
79 elsif ($pack eq "" || $pack eq "main") {
80 if ($export{$ident}) {
81 "$prefix$ident";
82 }
83 else {
84 "$prefix${pack}::$ident";
85 }
86 }
87 elsif ($pack eq $oldpack) {
88 "$prefix${newpack}::$ident";
89 }
90 else {
91 "$prefix${pack}::$ident";
92 }
93}
94__END__
95AUTOLOAD
96BEGIN
97CORE
98DESTROY
99END
100abs
101accept
102alarm
103and
104atan2
105bind
106binmode
107bless
108caller
109chdir
110chmod
111chop
112chown
113chr
114chroot
115close
116closedir
117cmp
118connect
119continue
120cos
121crypt
122dbmclose
123dbmopen
124defined
125delete
126die
127do
128dump
129each
130else
131elsif
132endgrent
133endhostent
134endnetent
135endprotoent
136endpwent
137endservent
138eof
139eq
140eval
141exec
142exit
143exp
144fcntl
145fileno
146flock
147for
148foreach
149fork
150format
151formline
152ge
153getc
154getgrent
155getgrgid
156getgrnam
157gethostbyaddr
158gethostbyname
159gethostent
160getlogin
161getnetbyaddr
162getnetbyname
163getnetent
164getpeername
165getpgrp
166getppid
167getpriority
168getprotobyname
169getprotobynumber
170getprotoent
171getpwent
172getpwnam
173getpwuid
174getservbyname
175getservbyport
176getservent
177getsockname
178getsockopt
179glob
180gmtime
181goto
182grep
183gt
184hex
185if
186index
187int
188ioctl
189join
190keys
191kill
192last
193lc
194lcfirst
195le
196length
197link
198listen
199local
200localtime
201log
202lstat
203lt
204m
205mkdir
206msgctl
207msgget
208msgrcv
209msgsnd
210my
211ne
212next
213no
214not
215oct
216open
217opendir
218or
219ord
220pack
221package
222pipe
223pop
224print
225printf
226push
227q
228qq
229quotemeta
230qw
231qx
232rand
233read
234readdir
235readline
236readlink
237readpipe
238recv
239redo
240ref
241rename
242require
243reset
244return
245reverse
246rewinddir
247rindex
248rmdir
249s
250scalar
251seek
252seekdir
253select
254semctl
255semget
256semop
257send
258setgrent
259sethostent
260setnetent
261setpgrp
262setpriority
263setprotoent
264setpwent
265setservent
266setsockopt
267shift
268shmctl
269shmget
270shmread
271shmwrite
272shutdown
273sin
274sleep
275socket
276socketpair
277sort
278splice
279split
280sprintf
281sqrt
282srand
283stat
284study
285sub
286substr
287symlink
288syscall
289sysread
290system
291syswrite
292tell
293telldir
294tie
295time
296times
297tr
298truncate
299uc
300ucfirst
301umask
302undef
303unless
304unlink
305unpack
306unshift
307untie
308until
309use
310utime
311values
312vec
313wait
314waitpid
315wantarray
316warn
317while
318write
319x
320xor
321y