view release on metacpan or  search on metacpan

private/MakeUtil.pm  view on Meta::CPAN

    for my $manifest (@manifests)
    {
        my $prefix = './';

        $prefix = $1
            if $manifest =~ m#^(.*/)#;

        open M, "<$manifest"
            or die "Cannot open '$manifest': $!\n";
        while (<M>)
        {
            chomp ;
            next if /^\s*#/ || /^\s*$/ ;

            s/^\s+//;
            s/\s+$//;

            #next if m#t/Test/More\.pm$# or m#t/Test/Builder\.pm$#;

            /^(\S+)\s*(.*)$/;

            my ($file, $rest) = ($1, $2);

            if ($file =~ /\.(pm|pl|t)$/ and $file !~ /MakeUtil.pm/)
            {
                push @files, "$prefix$file";
            }
            elsif ($rest =~ /perl/i)
            {
                push @files, "$prefix$file";
            }

        }
        close M;
    }

    return @files;
}

sub UpDowngrade
{
    return if defined $ENV{TipTop};

    my @files = @_ ;

    # our and use bytes/utf8 is stable from 5.6.0 onward
    # warnings is stable from 5.6.1 onward

    # Note: this code assumes that each statement it modifies is not
    #       split across multiple lines.


    my $warn_sub = '';
    my $our_sub = '' ;

    my $upgrade ;
    my $downgrade ;
    my $do_downgrade ;

    my $caller = (caller(1))[3] || '';

    if ($caller =~ /downgrade/)
    {
        $downgrade = 1;
    }
    elsif ($caller =~ /upgrade/)
    {
        $upgrade = 1;
    }
    else
    {
        $do_downgrade = 1
            if $] < 5.006001 ;
    }

#    else
#    {
#        my $opt = shift @ARGV || '' ;
#        $upgrade = ($opt =~ /^-upgrade/i);
#        $downgrade = ($opt =~ /^-downgrade/i);
#        push @ARGV, $opt unless $downgrade || $upgrade;
#    }


    if ($downgrade || $do_downgrade) {
        # From: use|no warnings "blah"
        # To:   local ($^W) = 1; # use|no warnings "blah"
        $warn_sub = sub {
                            s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
                            s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
                        };
    }
    #elsif ($] >= 5.006001 || $upgrade) {
    elsif ($upgrade) {
        # From: local ($^W) = 1; # use|no warnings "blah"
        # To:   use|no warnings "blah"
        $warn_sub = sub {
            s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
          };
    }

    if ($downgrade || $do_downgrade) {
        $our_sub = sub {
	    if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
                my $indent = $1;
                my $vars = join ' ', split /\s*,\s*/, $2;
                $_ = "${indent}use vars qw($vars);\n";
            }
	    elsif ( /^(\s*)((use|no)\s+(bytes|utf8)\s*;.*)$/)
            {
                $_ = "$1# $2\n";
            }
          };
    }
    #elsif ($] >= 5.006000 || $upgrade) {
    elsif ($upgrade) {
        $our_sub = sub {
	    if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
                my $indent = $1;
                my $vars = join ', ', split ' ', $2;