Installer: Early check whether the installation directory is writable
[msysgit.git] / bin / pl2pm
blob0fe871c99e04cab02e82dbf5ffa38ae18483c07d
1 #!/usr/bin/perl
2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
5 =head1 NAME
7 pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules.
9 =head1 SYNOPSIS
11 B<pl2pm> F<files>
13 =head1 DESCRIPTION
15 B<pl2pm> is a tool to aid in the conversion of Perl4-style .pl
16 library files to Perl5-style library modules. Usually, your old .pl
17 file will still work fine and you should only use this tool if you
18 plan to update your library to use some of the newer Perl 5 features,
19 such as AutoLoading.
21 =head1 LIMITATIONS
23 It's just a first step, but it's usually a good first step.
25 =head1 AUTHOR
27 Larry Wall <larry@wall.org>
29 =cut
31 use strict;
32 use warnings;
34 my %keyword = ();
36 while (<DATA>) {
37 chomp;
38 $keyword{$_} = 1;
41 local $/;
43 while (<>) {
44 my $newname = $ARGV;
45 $newname =~ s/\.pl$/.pm/ || next;
46 $newname =~ s#(.*/)?(\w+)#$1\u$2#;
47 if (-f $newname) {
48 warn "Won't overwrite existing $newname\n";
49 next;
51 my $oldpack = $2;
52 my $newpack = "\u$2";
53 my @export = ();
55 s/\bstd(in|out|err)\b/\U$&/g;
56 s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
57 if (/sub\s+\w+'/) {
58 @export = m/sub\s+\w+'(\w+)/g;
59 s/(sub\s+)main'(\w+)/$1$2/g;
61 else {
62 @export = m/sub\s+([A-Za-z]\w*)/g;
64 my @export_ok = grep($keyword{$_}, @export);
65 @export = grep(!$keyword{$_}, @export);
67 my %export = ();
68 @export{@export} = (1) x @export;
70 s/(^\s*);#/$1#/g;
71 s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
72 s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
73 s/([\$\@%&*])'(\w+)/&xlate($1,"",$2,$newpack,$oldpack,\%export)/eg;
74 s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3,$newpack,$oldpack,\%export)/eg;
75 if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
76 s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
77 s/\$\[\s*\+\s*//g;
78 s/\s*\+\s*\$\[//g;
79 s/\$\[/0/g;
81 s/open\s+(\w+)/open($1)/g;
83 my $export_ok = '';
84 my $carp ='';
87 if (s/\bdie\b/croak/g) {
88 $carp = "use Carp;\n";
89 s/croak "([^"]*)\\n"/croak "$1"/g;
92 if (@export_ok) {
93 $export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
96 if ( open(PM, ">$newname") ) {
97 print PM <<"END";
98 package $newpack;
99 use 5.006;
100 require Exporter;
101 $carp
102 \@ISA = qw(Exporter);
103 \@EXPORT = qw(@export);
104 $export_ok
108 else {
109 warn "Can't create $newname: $!\n";
113 sub xlate {
114 my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_;
116 my $xlated ;
117 if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
118 $xlated = "${pack}'$ident";
120 elsif ($pack eq '' || $pack eq 'main') {
121 if ($export->{$ident}) {
122 $xlated = "$prefix$ident";
124 else {
125 $xlated = "$prefix${pack}::$ident";
128 elsif ($pack eq $oldpack) {
129 $xlated = "$prefix${newpack}::$ident";
131 else {
132 $xlated = "$prefix${pack}::$ident";
135 return $xlated;
137 __END__
138 AUTOLOAD
139 BEGIN
140 CORE
141 DESTROY
143 INIT
144 CHECK
146 accept
147 alarm
149 atan2
150 bind
151 binmode
152 bless
153 caller
154 chdir
155 chmod
156 chomp
157 chop
158 chown
160 chroot
161 close
162 closedir
164 connect
165 continue
167 crypt
168 dbmclose
169 dbmopen
170 defined
171 delete
174 dump
175 each
176 else
177 elsif
178 endgrent
179 endhostent
180 endnetent
181 endprotoent
182 endpwent
183 endservent
186 eval
187 exec
188 exists
189 exit
191 fcntl
192 fileno
193 flock
195 foreach
196 fork
197 format
198 formline
200 getc
201 getgrent
202 getgrgid
203 getgrnam
204 gethostbyaddr
205 gethostbyname
206 gethostent
207 getlogin
208 getnetbyaddr
209 getnetbyname
210 getnetent
211 getpeername
212 getpgrp
213 getppid
214 getpriority
215 getprotobyname
216 getprotobynumber
217 getprotoent
218 getpwent
219 getpwnam
220 getpwuid
221 getservbyname
222 getservbyport
223 getservent
224 getsockname
225 getsockopt
226 glob
227 gmtime
228 goto
229 grep
233 index
235 ioctl
236 join
237 keys
238 kill
239 last
241 lcfirst
243 length
244 link
245 listen
246 local
247 localtime
248 lock
250 lstat
254 mkdir
255 msgctl
256 msgget
257 msgrcv
258 msgsnd
261 next
265 open
266 opendir
270 pack
271 package
272 pipe
275 print
276 printf
277 prototype
278 push
282 quotemeta
285 rand
286 read
287 readdir
288 readline
289 readlink
290 readpipe
291 recv
292 redo
294 rename
295 require
296 reset
297 return
298 reverse
299 rewinddir
300 rindex
301 rmdir
303 scalar
304 seek
305 seekdir
306 select
307 semctl
308 semget
309 semop
310 send
311 setgrent
312 sethostent
313 setnetent
314 setpgrp
315 setpriority
316 setprotoent
317 setpwent
318 setservent
319 setsockopt
320 shift
321 shmctl
322 shmget
323 shmread
324 shmwrite
325 shutdown
327 sleep
328 socket
329 socketpair
330 sort
331 splice
332 split
333 sprintf
334 sqrt
335 srand
336 stat
337 study
339 substr
340 symlink
341 syscall
342 sysopen
343 sysread
344 sysseek
345 system
346 syswrite
347 tell
348 telldir
350 tied
351 time
352 times
354 truncate
356 ucfirst
357 umask
358 undef
359 unless
360 unlink
361 unpack
362 unshift
363 untie
364 until
366 utime
367 values
369 wait
370 waitpid
371 wantarray
372 warn
373 while
374 write