File: local_package.t

package info (click to toggle)
libcpan-common-index-perl 0.010-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 1,900 kB
  • sloc: perl: 756; makefile: 11
file content (146 lines) | stat: -rw-r--r-- 4,122 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
use 5.008001;
use strict;
use warnings;
use Test::More 0.96;
use Test::FailWarnings;
use Test::Deep '!blessed';
use Test::Fatal;

use Cwd qw/getcwd/;
use File::Spec;
use File::Temp ();

use lib 't/lib';
use CommonTests;

my $cwd          = getcwd;
my $localgz      = File::Spec->catfile(qw/t CUSTOM mypackages.gz/);
my $local        = File::Spec->catfile(qw/t CUSTOM uncompressed/);
my $packages     = "mypackages";
my $uncompressed = "uncompressed";

sub new_local_index {
    my $cache = File::Temp->newdir;
    my $index = new_ok(
        'CPAN::Common::Index::LocalPackage' => [ { cache => $cache, source => $localgz } ],
        "new with cache and local gz"
    );
    is $index->cache, $cache, "the cache constructor attribute is respected";
    $index;
}

sub new_uncompressed_local_index {
    my $cache = File::Temp->newdir;
    my $index = new_ok(
        'CPAN::Common::Index::LocalPackage' => [ { cache => $cache, source => $local } ],
        "new with cache and local uncompressed"
    );
    is $index->cache, $cache, "the cache constructor attribute is respected";
    $index;
}

require_ok("CPAN::Common::Index::LocalPackage");

subtest "constructor tests" => sub {
    # no arguments, all defaults
    like(
        exception { CPAN::Common::Index::LocalPackage->new() },
        qr/'source' parameter must be provided/,
        "new with no args dies because source is required"
    );

    # missing file
    like(
        exception {
            CPAN::Common::Index::LocalPackage->new( { source => 'LDJFLKDJLJDLKD' } );
        },
        qr/index file .* does not exist/,
        "new with invalid source dies"
    );

    # source specified
    new_ok(
        'CPAN::Common::Index::LocalPackage' => [ { source => $localgz } ],
        "new with source"
    );

    # both specified
    new_local_index;

    # uncompressed variant
    new_uncompressed_local_index;
};

subtest 'refresh and unpack index files' => sub {
    plan skip_all => "IO::Uncompress::Gunzip is not available"
      unless $CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP;
    my $index = new_local_index;

    ok( !-e File::Spec->catfile( $index->cache, $packages ), "$packages not in cache" );

    ok( $index->refresh_index, "refreshed index" );

    ok( -e File::Spec->catfile( $index->cache, $packages ), "$packages in cache" );
};

subtest 'refresh and unpack uncompressed index files' => sub {
    my $index = new_uncompressed_local_index;

    ok( !-e File::Spec->catfile( $index->cache, $uncompressed ),
        "$uncompressed not in cache" );

    ok( $index->refresh_index, "refreshed index" );

    ok( -e File::Spec->catfile( $index->cache, $uncompressed ),
        "$uncompressed in cache" );
};

# XXX test that files in cache aren't overwritten?

sub common_tests {
    my ( $index_generater, $note );
    if ($CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP) {
        $index_generater = \&new_local_index;
        $note            = "with IO::Uncompress::Gunzip";
    }
    else {
        $index_generater = \&new_uncompressed_local_index;
        $note            = "without IO::Uncompress::Gunzip";
    }

    subtest "check index age $note" => sub {
        my $index   = $index_generater->();
        my $package = $index->cached_package;
        ok( -f $package, "got the package file" );
        my $expected_age = ( stat($package) )[9];
        is( $index->index_age, $expected_age, "index_age() is correct" );
    };

    subtest "find package $note" => sub {
        my $index = $index_generater->();
        test_find_package($index);
    };

    subtest "search package $note" => sub {
        my $index = $index_generater->();
        test_search_package($index);
    };
}

common_tests();
if ($CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP) {
    local $CPAN::Common::Index::Mirror::HAS_IO_UNCOMPRESS_GUNZIP = 0;
    common_tests();
}

done_testing;
#
# This file is part of CPAN-Common-Index
#
# This software is Copyright (c) 2013 by David Golden.
#
# This is free software, licensed under:
#
#   The Apache License, Version 2.0, January 2004
#
# vim: ts=4 sts=4 sw=4 et: