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