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