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.
127 my $caller = (caller(1))[3] || '';
129 if ($caller =~ /downgrade/)
133 elsif ($caller =~ /upgrade/)
139 # my $opt = shift @ARGV || '' ;
140 # $upgrade = ($opt =~ /^-upgrade/i);
141 # $downgrade = ($opt =~ /^-downgrade/i);
142 # push @ARGV, $opt unless $downgrade || $upgrade;
146 # From: use|no warnings "blah"
147 # To: local ($^W) = 1; # use|no warnings "blah"
149 s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
150 s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
153 elsif ($] >= 5.006001 || $upgrade) {
154 # From: local ($^W) = 1; # use|no warnings "blah"
155 # To: use|no warnings "blah"
157 s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
163 if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
165 my $vars = join ' ', split /\s*,\s*/, $2;
166 $_ = "${indent}use vars qw($vars);\n";
168 elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/)
174 elsif ($] >= 5.006000 || $upgrade) {
176 if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
178 my $vars = join ', ', split ' ', $2;
179 $_ = "${indent}our ($vars);\n";
181 elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/)
188 if (! $our_sub && ! $warn_sub) {
189 warn "Up/Downgrade not needed.\n";
190 if ($upgrade || $downgrade)
198 { doUpDown($our_sub, $warn_sub, $_) }
200 #{ doUpDownViaCopy($our_sub, $warn_sub, $_) }
203 warn "Up/Downgrade complete.\n" ;
204 exit 0 if $upgrade || $downgrade;
212 my $warn_sub = shift;
216 local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak";
217 local (@ARGV) = shift;
221 print, last if /^__(END|DATA)__/ ;
223 &{ $our_sub }() if $our_sub ;
224 &{ $warn_sub }() if $warn_sub ;
237 my $warn_sub = shift;
244 my $backup = $file . ($^O eq 'VMS') ? "_bak" : ".bak";
247 or die "Cannot copy $file to $backup: $!";
253 or die "Cannot open $file: $!\n" ;
256 if (/^__(END|DATA)__/)
262 &{ $our_sub }() if $our_sub ;
263 &{ $warn_sub }() if $warn_sub ;
277 or die "Cannot open $file: $!\n";