package MakeUtil ;
package main ;

use strict ;

use Config qw(%Config);
use File::Copy;

my $VERSION = '1.0';


BEGIN
{
    eval { require File::Spec::Functions ; File::Spec::Functions->import() } ;
    if ($@)
    {
        *catfile = sub { return "$_[0]/$_[1]" }
    }
}

require VMS::Filespec if $^O eq 'VMS';


unless($ENV{PERL_CORE}) {
    $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
}

$ENV{SKIP_FOR_CORE} = 1 if $ENV{PERL_CORE} || $ENV{MY_PERL_CORE} ;



sub MY::libscan
{
    my $self = shift;
    my $path = shift;

    return undef
        if $path =~ /(~|\.bak|_bak)$/ ||
           $path =~ /\..*\.sw(o|p)$/  ||
           $path =~ /\B\.svn\b/;

    return $path;
}

sub MY::postamble
{
    return ''
        if $ENV{PERL_CORE} ;

    my @files = getPerlFiles('MANIFEST');

    # Note: Once you remove all the layers of shell/makefile escaping
    # the regular expression below reads
    #
    #    /^\s*local\s*\(\s*\$^W\s*\)/
    #
    my $postamble = '

MyTrebleCheck:
	@echo Checking for $$^W in files: '. "@files" . '
	perl -ne \'						\
	    exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/; \'		\
         ' . " @files || " . '				\
	(echo found unexpected $$^W ; exit 1)
	@echo All is ok.

';

    return $postamble;
}

sub getPerlFiles
{
    my @manifests = @_ ;

    my @files = ();

    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;
#                 $_ = "${indent}our ($vars);\n";
#             }
# 	    elsif ( /^(\s*)#\s*((use|no)\s+(bytes|utf8)\s*;.*)$/)
#             {
#                 $_ = "$1$2\n";
#             }
#           };
#     }
#
#     if (! $our_sub && ! $warn_sub) {
#         warn "Up/Downgrade not needed.\n";
# 	if ($upgrade || $downgrade)
#           { exit 0 }
#         else
#           { return }
#     }
#
#     foreach (@files) {
#         #if (-l $_ )
#           { doUpDown($our_sub, $warn_sub, $_) }
#           #else
#           #{ doUpDownViaCopy($our_sub, $warn_sub, $_) }
#     }
#
#     warn "Up/Downgrade complete.\n" ;
#     exit 0 if $upgrade || $downgrade;
#
# }
#
#
# sub doUpDown
# {
#     my $our_sub = shift;
#     my $warn_sub = shift;
#
#     return if -d $_[0];
#
#     local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak";
#     local (@ARGV) = shift;
#
#     while (<>)
#     {
#         print, last if /^__(END|DATA)__/ ;
#
#         &{ $our_sub }() if $our_sub ;
#         &{ $warn_sub }() if $warn_sub ;
#         print ;
#     }
#
#     return if eof ;
#
#     while (<>)
#       { print }
# }
#
# sub doUpDownViaCopy
# {
#     my $our_sub = shift;
#     my $warn_sub = shift;
#     my $file     = shift ;
#
#     use File::Copy ;
#
#     return if -d $file ;
#
#     my $backup = $file . ($^O eq 'VMS') ? "_bak" : ".bak";
#
#     copy($file, $backup)
#         or die "Cannot copy $file to $backup: $!";
#
#     my @keep = ();
#
#     {
#         open F, "<$file"
#             or die "Cannot open $file: $!\n" ;
#         while (<F>)
#         {
#             if (/^__(END|DATA)__/)
#             {
#                 push @keep, $_;
#                 last ;
#             }
#
#             &{ $our_sub }() if $our_sub ;
#             &{ $warn_sub }() if $warn_sub ;
#             push @keep, $_;
#         }
#
#         if (! eof F)
#         {
#             while (<F>)
#               { push @keep, $_ }
#         }
#         close F;
#     }
#
#     {
#         open F, ">$file"
#             or die "Cannot open $file: $!\n";
#         print F @keep ;
#         close F;
#     }
# }
#
#
# sub FindBrokenDependencies
# {
#     my $version = shift ;
#     my %thisModule = map { $_ => 1} @_;
#
#     my @modules = qw(
#                     IO::Compress::Base
#                     IO::Compress::Base::Common
#                     IO::Uncompress::Base
#
#                     Compress::Raw::Zlib
#                     Compress::Raw::Bzip2
#
#                     IO::Compress::RawDeflate
#                     IO::Uncompress::RawInflate
#                     IO::Compress::Deflate
#                     IO::Uncompress::Inflate
#                     IO::Compress::Gzip
#                     IO::Compress::Gzip::Constants
#                     IO::Uncompress::Gunzip
#                     IO::Compress::Zip
#                     IO::Uncompress::Unzip
#
#                     IO::Compress::Bzip2
#                     IO::Uncompress::Bunzip2
#
#                     IO::Compress::Lzf
#                     IO::Uncompress::UnLzf
#
#                     IO::Compress::Lzop
#                     IO::Uncompress::UnLzop
#
#                     Compress::Zlib
#                     );
#
#     my @broken = ();
#
#     foreach my $module ( grep { ! $thisModule{$_} } @modules)
#     {
#         my $hasVersion = getInstalledVersion($module);
#
#         # No need to upgrade if the module isn't installed at all
#         next
#             if ! defined $hasVersion;
#
#         # If already have C::Z version 1, then an upgrade to any of the
#         # IO::Compress modules will not break it.
#         next
#             if $module eq 'Compress::Zlib' && $hasVersion < 2;
#
#         if ($hasVersion < $version)
#         {
#             push @broken, $module
#         }
#     }
#
#     return @broken;
# }
#
# sub getInstalledVersion
# {
#     my $module = shift;
#     my $version;
#
#     eval " require $module; ";
#
#     if ($@ eq '')
#     {
#         no strict 'refs';
#         $version = ${ $module . "::VERSION" };
#         $version = 0
#     }
#
#     return $version;
# }

package MakeUtil ;

1;
