6 use Config qw(%Config);
12 eval { require File::Spec::Functions ; File::Spec::Functions->import() } ;
15 *catfile = sub { return "$_[0]/$_[1]" }
19 require VMS::Filespec if $^O eq 'VMS';
22 unless($ENV{PERL_CORE}) {
23 $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
26 $ENV{SKIP_FOR_CORE} = 1 if $ENV{PERL_CORE} || $ENV{MY_PERL_CORE} ;
36 if $path =~ /(~|\.bak|_bak)$/ ||
37 $path =~ /\..*\.sw(o|p)$/ ||
48 my @files = getPerlFiles('MANIFEST');
53 @echo Checking for $$^W in files: '. "@files" . '
55 exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/; \
56 \' ' . " @files || " . ' \
57 (echo found unexpected $$^W ; exit 1)
71 for my $manifest (@manifests)
76 if $manifest =~ m#^(.*/)#;
79 or die "Cannot open '$manifest': $!\n";
83 next if /^\s*#/ || /^\s*$/ ;
90 my ($file, $rest) = ($1, $2);
92 if ($file =~ /\.(pm|pl|t)$/ and $file !~ /MakeUtil.pm/)
94 push @files, "$prefix$file";
96 elsif ($rest =~ /perl/i)
98 push @files, "$prefix$file";
110 return if defined $ENV{TipTop};
114 # our and use bytes/utf8 is stable from 5.6.0 onward
115 # warnings is stable from 5.6.1 onward
117 # Note: this code assumes that each statement it modifies is not
118 # split across multiple lines.
128 my $caller = (caller(1))[3] || '';
130 if ($caller =~ /downgrade/)
134 elsif ($caller =~ /upgrade/)
146 # my $opt = shift @ARGV || '' ;
147 # $upgrade = ($opt =~ /^-upgrade/i);
148 # $downgrade = ($opt =~ /^-downgrade/i);
149 # push @ARGV, $opt unless $downgrade || $upgrade;
153 if ($downgrade || $do_downgrade) {
154 # From: use|no warnings "blah"
155 # To: local ($^W) = 1; # use|no warnings "blah"
157 s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
158 s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
161 #elsif ($] >= 5.006001 || $upgrade) {
163 # From: local ($^W) = 1; # use|no warnings "blah"
164 # To: use|no warnings "blah"
166 s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
170 if ($downgrade || $do_downgrade) {
172 if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
174 my $vars = join ' ', split /\s*,\s*/, $2;
175 $_ = "${indent}use vars qw($vars);\n";
177 elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/)
183 #elsif ($] >= 5.006000 || $upgrade) {
186 if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
188 my $vars = join ', ', split ' ', $2;
189 $_ = "${indent}our ($vars);\n";
191 elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/)
198 if (! $our_sub && ! $warn_sub) {
199 warn "Up/Downgrade not needed.\n";
200 if ($upgrade || $downgrade)
208 { doUpDown($our_sub, $warn_sub, $_) }
210 #{ doUpDownViaCopy($our_sub, $warn_sub, $_) }
213 warn "Up/Downgrade complete.\n" ;
214 exit 0 if $upgrade || $downgrade;
222 my $warn_sub = shift;
226 local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak";
227 local (@ARGV) = shift;
231 print, last if /^__(END|DATA)__/ ;
233 &{ $our_sub }() if $our_sub ;
234 &{ $warn_sub }() if $warn_sub ;
247 my $warn_sub = shift;
254 my $backup = $file . ($^O eq 'VMS') ? "_bak" : ".bak";
257 or die "Cannot copy $file to $backup: $!";
263 or die "Cannot open $file: $!\n" ;
266 if (/^__(END|DATA)__/)
272 &{ $our_sub }() if $our_sub ;
273 &{ $warn_sub }() if $warn_sub ;
287 or die "Cannot open $file: $!\n";