12cpan.t

BEGIN {
    $|++;
    local $^W;
    eval "qr/qr/";
    if ($@) {
        $|=1;
        print "1..0 # SKIP no qr//\n";
        eval "require POSIX; 1" and POSIX::_exit(0);
    }
}
my $count;
use strict;
use Test::More;
use File::Spec;
sub _f ($) {
    File::Spec->catfile(split /\//, shift);
}
use File::Copy qw(cp);
unlink _f"t/CPAN/MyConfig.pm";		# cp non-overwriting on OS/2
cp _f"t/CPAN/TestConfig.pm", _f"t/CPAN/MyConfig.pm"
    or die "Could not cp t/CPAN/TestConfig.pm over t/CPAN/MyConfig.pm: $!";
unshift @INC, "t";
require CPAN::MyConfig;
require CPAN;
require CPAN::Kwalify;
require CPAN::HandleConfig;
{
    eval {CPAN::rtlpr()};
    like $@, qr/Unknown CPAN command/,q/AUTOLOAD rejects/;
    BEGIN{$count++}
}
{
    my $rdep = CPAN::Exception::RecursiveDependency->new([qw(foo bar baz)]);
    like $rdep, qr/^--not.*--$/, "not a recursive/circular dependency";
    BEGIN{$count++}
}
{
    my $rdep = CPAN::Exception::RecursiveDependency->new([qw(foo bar baz foo)]);
    like $rdep, qr/foo.+=>.+bar.+=>.+baz.+=>.+foo/s, "circular dependency";
    BEGIN{$count++}
}
{
    my $a = CPAN::Shell->expand("Module",
                                "CPAN::Test::Dummy::Perl5::Make"
                               )->distribution->author->as_string;
    like $a, qr/Andreas/, "found Andreas in CPAN::Test::Dummy::Perl5::Make";
    BEGIN{$count++}
}
{
    no strict;
    {
        package S;
        for my $m (qw(myprint mydie mywarn mysleep)){
            *$m = sub {
                return;
            }
        }
    }
    $CPAN::Frontend = $CPAN::Frontend = "S";
    $_ = "Fcntl";
    my $m = CPAN::Shell->expand(Module => $_);
    $m->uptodate;
    is($_,"Fcntl","\$_ is properly localized");
    BEGIN{$count++}
}
{
    my @s;
    BEGIN{
        @s=(
            '"a"',
            '["a"]',
            '{a=>"b"}',
            '{"a;"=>"b"}',
            '"\\\\"',
           );
        $count+=@s;
    }
    for (0..$#s) {
        my $x = eval $s[$_];
        my $y = CPAN::HandleConfig->neatvalue($x);
        my $z = eval $y;
        is_deeply($z,$x,"s[$_]");
    }
}
{
    my $this_block_count;
    BEGIN { $count += $this_block_count = 2; }
    eval { require Kwalify; require YAML; }; # most of the kwalify
                                             # stuff does not work
                                             # without yaml
    if ($@ || (($YAML::VERSION||$YAML::VERSION||0) < 0.62)) { # silence 5.005_04
        for (1..$this_block_count) {
            ok(1, "dummy Kwalify/YAML $_");
        }
    } else {
        my $data = {
                    "match" => {
                                "distribution" => "^(ABW|ADAMK)/Template-Toolkit-2.16"
                               },
                    "pl" => {
                             "args" => [
                                        "TT_EXTRAS=no"
                                       ],
                             "expect" => [
                                          "Do you want to build the XS Stash module",
                                          "n\n",
                                          "Do you want to install these components",
                                          "n\n",
                                          "Installation directory",
                                          "\n",
                                          "URL base for TT2 images",
                                          "\n",
                                         ],
                             barth => '1984',
                            },
                   };
        eval {CPAN::Kwalify::_validate("distroprefs",
                                       $data,
                                       _f("t/12cpan.t"),
                                       0)};
        ok($@,"no kwalify [$@]");
        delete $data->{pl}{barth};
        CPAN::Kwalify::_clear_cache();
        eval {CPAN::Kwalify::_validate("distroprefs",
                                       $data,
                                       _f("t/12cpan.t"),
                                       0)};
        ok(!$@,"kwalify ok");
    }
}

{
    my $this_block_count;
    BEGIN { $count += $this_block_count = 8; }

    eval { require YAML::Syck; };
    my $excuse;
    if ($@) {
        $excuse = "YAML::Syck not available";
    } elsif (($YAML::Syck::VERSION||$YAML::Syck::VERSION||0) < 0.97) { # silence 5.005_04
        $excuse = "YAML::Syck too old";
    } elsif ($] < 5.008) {
        $excuse = "Defered code segfaults on 5.6.x";
    }
    if ($excuse) {
        for (1..$this_block_count) {
            ok(1, "Skipping ($excuse) $_");
        }
    } else {
        my $yaml_file = _f('t/yaml_code.yml');

        local $CPAN::Config->{yaml_module} = 'YAML::Syck';

        {
            my $data = CPAN->_yaml_loadfile($yaml_file)->[0];

            local $::yaml_load_code_works = 0;

            my $code = $data->{code};
            is(ref $code, 'CODE', 'deserialisation returned CODE');
            $code->();
            is($::yaml_load_code_works, 0, 'running the code did the right thing');

            my $obj = $data->{object};
            isa_ok($obj, 'CPAN::DeferredCode');
            local $^W;
            my $dummy = "$obj";
            is($::yaml_load_code_works, 0, 'stringifying the obj does nothing');
        }

        {
            local $CPAN::Config->{yaml_load_code} = 1;

            my $data = CPAN->_yaml_loadfile($yaml_file)->[0];

            local $::yaml_load_code_works = 0;

            my $code = $data->{code};
            is(ref $code, 'CODE', 'deserialisation returned CODE');
            $code->();
            is($::yaml_load_code_works, 1, 'running the code did the right thing');

            my $obj = $data->{object};
            isa_ok($obj, 'CPAN::DeferredCode');
            my $dummy = "$obj";
            is($::yaml_load_code_works, 2, 'stringifying the obj ran the code');
        }
    }
}

{
    my $this_block_count;
    my @no_proxy;
    BEGIN {
        @no_proxy = ({
                      domain => "at",
                      expect => 1,
                     },
                     {
                      domain => "kh",
                      expect => 0,
                     },
                    );
        $this_block_count = 3 * @no_proxy;
        $count += $this_block_count;
    }
    my $ftp = "CPAN::FTP";
    $CPAN::Config->{http_proxy} = "http://myproxy.local/";
    $CPAN::Config->{proxy_user} = "myproxyuser";
    $CPAN::Config->{proxy_pass} = "myproxypass";
    $ENV{PERL_MM_USE_DEFAULT} = 1;
    for my $n (@no_proxy) {
        $CPAN::Config->{no_proxy} = $n->{domain};
        my $pftpvars = $ftp->_proxy_vars("http://battambang.kh/");
        for my $k (qw(http_proxy proxy_user proxy_pass)) {
            my $v = defined $pftpvars->{$k} ? $pftpvars->{$k} : "UNDEF";
            ok($n->{expect}
               ==
               !!$pftpvars->{$k},
               "found $k\[$v] on domain[$n->{domain}]");
        }
    }
}

{
    my $this_block_count;
    BEGIN {
        $this_block_count = 2;
        $count += $this_block_count;
    }
    use CPAN::FirstTime;
    my $keys = keys %CPAN::FirstTime::prompts;
    ok $keys>=105, "found keys[$keys] prompts";
    my $join = join "", %CPAN::FirstTime::prompts;
    my $length = length $join;
    ok $length>=20468, "found length[$length] prompts";
}

BEGIN{plan tests => $count}

# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# End: