The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BEGIN { 
    if( $ENV{PERL_CORE} ) {
        chdir '../lib/CPANPLUS' if -d '../lib/CPANPLUS';
        unshift @INC, '../../../lib';
    
        ### fix perl location too
        $^X = '../../../t/' . $^X;
    }
} 

#!/usr/bin/perl -w

BEGIN { chdir 't' if -d 't' };

### this is to make devel::cover happy ###
BEGIN {
    use File::Spec;
    require lib;
    for (qw[../lib inc]) { my $l = 'lib'; $l->import(File::Spec->rel2abs($_)) }
}
use strict;

use CPANPLUS::inc;
use CPANPLUS::Configure;
use CPANPLUS::Backend;
use CPANPLUS::Dist;
use CPANPLUS::Dist::MM;
use CPANPLUS::Internals::Constants;

use Test::More 'no_plan';
use Cwd;
use Config;
use Data::Dumper;
use File::Basename ();
use File::Spec ();

BEGIN { require 'conf.pl'; }

my $conf    = gimme_conf();
my $cb      = CPANPLUS::Backend->new( $conf );
my $noperms = ($< and not $conf->get_program('sudo')) &&
              ($conf->get_conf('makemakerflags') or
                not -w $Config{installsitelib} );

### don't start sending test reports now... ###
$cb->_callbacks->send_test_report( sub { 0 } );
$conf->set_conf( cpantest => 0 );

### Redirect errors to file ###
local $CPANPLUS::Error::ERROR_FH = output_handle() unless @ARGV;
local $CPANPLUS::Error::MSG_FH   = output_handle() unless @ARGV;
*STDOUT                          = output_handle() unless @ARGV;
*STDERR                          = output_handle() unless @ARGV;

### start with fresh sources ###
ok( $cb->reload_indices( update_source => 0 ),
                                "Rebuilding trees" );

### set alternate install dir ###
### XXX rather pointless, since we can't uninstall them, due to a bug
### in EU::Installed (6871). And therefor we can't test uninstall() or any of
### the EU::Installed functions. So, let's just install into sitelib... =/
#my $prefix  = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
#my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
#ok( $rv,                        "Alternate install path set" );

### enable signature checks ###
ok( $conf->set_conf( signature => 1 ),
                                "Enabling signature checks" );

my $mod = $cb->module_tree('Text::Bastardize');

### format_available tests ###
{   ok( CPANPLUS::Dist::MM->format_available,
                                "Format is available" );

    ### whitebox test!
    {   local $^W;
        local *CPANPLUS::Dist::MM::can_load = sub { 0 };
        ok(!CPANPLUS::Dist::MM->format_available,
                                "   Making format unavailable" );
    }

    ### test if the error got logged ok ###
    like( CPANPLUS::Error->stack_as_string,
          qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
                                "   Format failure logged" );

    ### flush the stack ###
    CPANPLUS::Error->flush;
}

ok( $mod->fetch,                "Fetching module" );
ok( $mod->extract,              "Extracting module" );

ok( $mod->test,                 "Testing module" );
ok( $mod->status->dist_cpan->status->test,
                                "   Test success registered as status" );
ok( $mod->status->dist_cpan->status->prepared,
                                "   Prepared status registered" );
ok( $mod->status->dist_cpan->status->created,
                                "   Created status registered" );
is( $mod->status->dist_cpan->status->distdir, $mod->status->extract,
                                "   Distdir status registered properly" );

### test the convenience methods
ok( $mod->prepare,              "Preparing module" );
ok( $mod->create,               "Creating module" );

ok( $mod->dist,                 "Building distribution" );
ok( $mod->status->dist_cpan,    "   Dist registered as status" );
isa_ok( $mod->status->dist_cpan,    "CPANPLUS::Dist::MM" );

### flush the lib cache
### otherwise, cpanplus thinks the module's already installed
### since the blib is already in @INC
$cb->_flush( list => [qw|lib|] );

diag("\nSorry, installing into your real perl dir, rather than our test area");
diag('since ExtUtils::Installed does not probe for .packlists in other dirs');
diag('than those in %Config. See bug #6871 on rt.cpan.org for details');

SKIP: {

    skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE};

    skip(q[Probably no permissions to install, skipping], 10)
        if $noperms;

    
    diag(q[Note: 'sudo' might ask for your password to do the install test])
        if $conf->get_program('sudo');

    ok( $mod->install( force =>1 ),
                                "Installing module" );
    ok( $mod->status->installed,"   Module installed according to status" );


    SKIP: {   ### EU::Installed tests ###
        skip("makemakerflags set -- probably EU::Installed tests will fail", 8)
            if $conf->get_conf('makemakerflags');

        skip("Old perl on cygwin detected -- tests will fail due to know bugs", 8)
            if ON_OLD_CYGWIN;

        {   ### validate
            my @missing = $mod->validate;

            is_deeply( \@missing, [],
                                    "No missing files" );
        }

        {   ### files
            my @files = $mod->files;

            ### number of files may vary from OS to OS
            ok( scalar(@files),     "All files accounted for" );
            ok( grep( /Bastardize\.pm/, @files),
                                    "   Found the module" );

            ### XXX does this work on all OSs?
            #ok( grep( /man/, @files ),
            #                        "   Found the manpage" );
        }

        {   ### packlist
            my ($obj) = $mod->packlist;
            isa_ok( $obj,           "ExtUtils::Packlist" );
        }

        {   ### directory_tree
            my @dirs = $mod->directory_tree;
            ok( scalar(@dirs),      "Directory tree obtained" );

            my $found;
            for my $dir (@dirs) {
                ok( -d $dir,        "   Directory exists" );

                my $file = File::Spec->catfile( $dir, "Bastardize.pm" );
                $found = $file if -e $file;
            }

            ok( -e $found,          "   Module found" );
        }

        SKIP: {
            skip("Probably no permissions to uninstall", 1)
                if $noperms;

            ok( $mod->uninstall,    "Uninstalling module" );
        }
    }
}

### test exceptions in Dist::MM->create ###
{   ok( $mod->status->mk_flush, "Old status info flushed" );
    my $dist = CPANPLUS::Dist->new( module => $mod,
                                    format => INSTALLER_MM );

    ok( $dist,                  "New dist object made" );
    ok(!$dist->prepare,         "   Dist->prepare failed" );
    like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
                                "       Failure logged" );

    ### manually set the extract dir,
    $mod->status->extract($0);

    ok(!$dist->create,          "   Dist->create failed" );
    like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
                                "       Failure logged" );

    ### pretend we've been prepared ###
    $dist->status->prepared(1);

    ok(!$dist->create,          "   Dist->create failed" );
    like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
                                "       Failure logged" );
}

### writemakefile.pl tests ###
{   ### remove old status info
    ok( $mod->status->mk_flush, "Old status info flushed" );
    ok( $mod->fetch,            "Module fetched again" );
    ok( $mod->extract,          "Module extracted again" );

    ### cheat and add fake prereqs ###
    $mod->status->prereqs( { strict => '0.001', Carp => '0.002' } );

    my $makefile_pl = MAKEFILE_PL->( $mod->status->extract );
    my $makefile    = MAKEFILE->(    $mod->status->extract );

    my $dist        = $mod->dist;
    ok( $dist,                  "Dist object built" );

    ### check for a makefile.pl and 'write' one
    ok( -s $makefile_pl,        "   Makefile.PL present" );
    ok( $dist->write_makefile_pl( force => 0 ),
                                "   Makefile.PL written" );
    like( CPANPLUS::Error->stack_as_string, qr/Already created/,
                                "   Prior existance noted" );

    ### ok, unlink the makefile.pl, now really write one
    unlink $makefile;

    ok( unlink($makefile_pl),   "Deleting Makefile.PL");
    ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
    ok( !-s $makefile,          "   Makefile deleted" );
    ok($dist->write_makefile_pl,"   Makefile.PL written" );

    ### see if we wrote anything sensible
    my $fh = OPEN_FILE->( $makefile_pl );
    ok( $fh,                    "Makefile.PL open for read" );

    my $str = do { local $/; <$fh> };
    like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
                                "   Autogeneration noted" );
    like( $str, '/'. $mod->module .'/',
                                "   Contains module name" );
    like( $str, '/'. quotemeta($mod->version) . '/',
                                "   Contains version" );
    like( $str, '/'. $mod->author->author .'/',
                                "   Contains author" );
    like( $str, '/PREREQ_PM/',  "   Contains prereqs" );
    like( $str, qr/Carp.+0.002/,"   Contains prereqs" );
    like( $str, qr/strict.+001/,"   Contains prereqs" );

    close $fh;

    ### seems ok, now delete it again and go via install()
    ### to see if it picks up on the missing makefile.pl and
    ### does the right thing
    ok( unlink($makefile_pl),   "Deleting Makefile.PL");
    ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
    ok( $dist->status->mk_flush,"Dist status flushed" );
    ok( $dist->prepare,         "   Dist->prepare run again" );
    ok( $dist->create,          "   Dist->create run again" );
    ok( -s $makefile_pl,        "   Makefile.PL present" );
    like( CPANPLUS::Error->stack_as_string,
          qr/attempting to generate one/,
                                "   Makefile.PL generation attempt logged" );

    ### now let's throw away the makefile.pl, flush the status and not
    ### write a makefile.pl
    {   local $^W;
        local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };

        unlink $makefile_pl;
        unlink $makefile;

        ok(!-s $makefile_pl,        "Makefile.PL deleted" );
        ok(!-s $makefile,           "Makefile deleted" );
        ok( $dist->status->mk_flush,"Dist status flushed" );
        ok(!$dist->prepare,         "   Dist->prepare failed" );
        like( CPANPLUS::Error->stack_as_string,
              qr/Could not find 'Makefile.PL'/i,
                                    "   Missing Makefile.PL noted" );
        is( $dist->status->makefile, 0,
                                    "   Did not manage to create Makefile" );
    }

    ### now let's write a makefile.pl that just does 'die'
    {   local $^W;
        local *CPANPLUS::Dist::MM::write_makefile_pl = sub {
                my $dist = shift; my $self = $dist->parent;
                my $fh = OPEN_FILE->(
                            MAKEFILE_PL->($self->status->extract), '>' );
                print $fh "die '$0'";
                close $fh;
            };

        ### there's no makefile.pl now, since the previous test failed
        ### to create one
        #ok( -e $makefile_pl,        "Makefile.PL exists" );
        #ok( unlink($makefile_pl),   "   Deleting Makefile.PL");
        ok(!-s $makefile_pl,        "Makefile.PL deleted" );
        ok( $dist->status->mk_flush,"Dist status flushed" );
        ok(!$dist->prepare,         "   Dist->prepare failed" );
        like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
                                    "   Logged failed 'perl Makefile.PL'" );
        is( $dist->status->makefile, 0,
                                    "   Did not manage to create Makefile" );
    }

    ### clean up afterwards ###
    ok( unlink($makefile_pl),   "Deleting Makefile.PL");
    $dist->status->mk_flush;

}


# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: