1#!/usr/bin/perl 2########################################### 3# 5005it -- make a PM file 5005-compatible 4# Mike Schilli, 2002 (m@perlmeister.com) 5########################################### 6use 5.00503; 7use strict; 8 9use File::Find; 10 11my $USEVARS_DONE = 0; 12my @OUR_VARS = (); 13 14########################################### 15sub mk5005 { 16########################################### 17 find(\&process_file, "lib", "t"); 18} 19 20########################################### 21sub process_file { 22########################################### 23 my($file) = $_; 24 25 return unless -f $file; 26 27 $USEVARS_DONE = 0; 28 @OUR_VARS = (); 29 30 open FILE, "<$file" or die "Cannot open $file"; 31 my $data = join '', <FILE>; 32 close FILE; 33 34 while($data =~ /^our[\s(]+([\$%@][\w_]+).*[;=]/mg) { 35 push @OUR_VARS, $1; 36 } 37 38 # Replace 'our' variables 39 $data =~ s/^our[\s(]+[\$%@][\w_]+.*/rep_our($&)/meg; 40 41 # Replace 'use 5.006' lines 42 $data =~ s/^use\s+5\.006/\nuse 5.00503/mg; 43 44 # Delete 'no/use warnings;': \s seems to eat newlines, so use [] 45 $data =~ s/^[ \t]*use warnings;//mg; 46 $data =~ s/^[ \t]*no warnings.*?;/\$\^W = undef;/mg; 47 48 # 5.00503 can't handle constants that start with a _ 49 $data =~ s/_INTERNAL_DEBUG/INTERNAL_DEBUG/g; 50 51 # Anything before 5.6.0 doesn't have the two argument binmode. 52 # Convert to one arg version by discarding second arg. 53 $data =~ s{ binmode \s* \(? (.*?) , .* \)? \s* ; }{ "binmode $1 ;" }gex; 54 55 open FILE, ">$file" or die "Cannot open $file"; 56 print FILE $data; 57 close FILE; 58} 59 60########################################### 61sub rep_our { 62########################################### 63 my($line) = @_; 64 65 my $out = ""; 66 67 if(!$USEVARS_DONE) { 68 $out = "use vars qw(" . join(" ", @OUR_VARS) . "); "; 69 $USEVARS_DONE = 1; 70 } 71 72 if($line =~ /=/) { 73 # There's an assignment, just skip the 'our' 74 $line =~ s/^our\s+//; 75 } else { 76 # There's nothing, just get rid of the entire line 77 $line = "\n"; 78 } 79 80 $out .= $line; 81 return $out; 82} 83 841; 85