6 use Config qw(%Config);
14 eval { require File::Spec::Functions ; File::Spec::Functions->import() } ;
17 *catfile = sub { return "$_[0]/$_[1]" }
21 require VMS::Filespec if $^O eq 'VMS';
24 unless($ENV{PERL_CORE}) {
25 $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
28 $ENV{SKIP_FOR_CORE} = 1 if $ENV{PERL_CORE} || $ENV{MY_PERL_CORE} ;
38 if $path =~ /(~|\.bak|_bak)$/ ||
39 $path =~ /\..*\.sw(o|p)$/ ||
50 my @files = getPerlFiles('MANIFEST');
55 @echo Checking for $$^W in files: '. "@files" . '
57 exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/; \
58 \' ' . " @files || " . ' \
59 (echo found unexpected $$^W ; exit 1)
73 for my $manifest (@manifests)
78 if $manifest =~ m#^(.*/)#;
81 or die "Cannot open '$manifest': $!\n";
85 next if /^\s*#/ || /^\s*$/ ;
92 my ($file, $rest) = ($1, $2);
94 if ($file =~ /\.(pm|pl|t)$/ and $file !~ /MakeUtil.pm/)
96 push @files, "$prefix$file";
98 elsif ($rest =~ /perl/i)
100 push @files, "$prefix$file";
112 return if defined $ENV{TipTop};
116 # our and use bytes/utf8 is stable from 5.6.0 onward
117 # warnings is stable from 5.6.1 onward
119 # Note: this code assumes that each statement it modifies is not
120 # split across multiple lines.
130 my $caller = (caller(1))[3] || '';
132 if ($caller =~ /downgrade/)
136 elsif ($caller =~ /upgrade/)
148 # my $opt = shift @ARGV || '' ;
149 # $upgrade = ($opt =~ /^-upgrade/i);
150 # $downgrade = ($opt =~ /^-downgrade/i);
151 # push @ARGV, $opt unless $downgrade || $upgrade;
155 if ($downgrade || $do_downgrade) {
156 # From: use|no warnings "blah"
157 # To: local ($^W) = 1; # use|no warnings "blah"
159 s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
160 s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
163 #elsif ($] >= 5.006001 || $upgrade) {
165 # From: local ($^W) = 1; # use|no warnings "blah"
166 # To: use|no warnings "blah"
168 s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
172 if ($downgrade || $do_downgrade) {
174 if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
176 my $vars = join ' ', split /\s*,\s*/, $2;
177 $_ = "${indent}use vars qw($vars);\n";
179 elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/)
185 #elsif ($] >= 5.006000 || $upgrade) {
188 if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
190 my $vars = join ', ', split ' ', $2;
191 $_ = "${indent}our ($vars);\n";
193 elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/)
200 if (! $our_sub && ! $warn_sub) {
201 warn "Up/Downgrade not needed.\n";
202 if ($upgrade || $downgrade)
210 { doUpDown($our_sub, $warn_sub, $_) }
212 #{ doUpDownViaCopy($our_sub, $warn_sub, $_) }
215 warn "Up/Downgrade complete.\n" ;
216 exit 0 if $upgrade || $downgrade;
224 my $warn_sub = shift;
228 local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak";
229 local (@ARGV) = shift;
233 print, last if /^__(END|DATA)__/ ;
235 &{ $our_sub }() if $our_sub ;
236 &{ $warn_sub }() if $warn_sub ;
249 my $warn_sub = shift;
256 my $backup = $file . ($^O eq 'VMS') ? "_bak" : ".bak";
259 or die "Cannot copy $file to $backup: $!";
265 or die "Cannot open $file: $!\n" ;
268 if (/^__(END|DATA)__/)
274 &{ $our_sub }() if $our_sub ;
275 &{ $warn_sub }() if $warn_sub ;
289 or die "Cannot open $file: $!\n";