1#!/usr/bin/perl
2use strict;
3use Test::InDistDir;
4use Test::More;
5use File::Slurp 'read_file';
6
7run();
8done_testing;
9
10sub run {
11    use_ok( "Parse::CPAN::Packages" );
12
13    default_features();
14
15    my $raw_data = read_file( "t/02packages.details.txt" );
16    my $gz_data = read_file( "t/02packages.details.txt.gz", binmode => ':raw' );
17
18    creation_check( "t/02packages.details.txt.gz", "gzip file is parsed" );
19    creation_check( $raw_data,                     "text contents are parsed" );
20    creation_check( $gz_data,                      "gzip contents are parsed" );
21
22    dist_contents( "t/mirror/modules/02packages.details.txt.gz", "mirror file with implicit mirror directory" );
23    dist_contents( filename => "t/02packages.details.txt", mirror_dir => "t/mirror", "mirror file with explicit mirror dir" );
24
25    return;
26}
27
28sub default_features {
29    my ( $p, @packages ) = creation_check( "t/02packages.details.txt", "text file is parsed" );
30
31    is( $p->file,         '02packages.details.txt',                                  'file' );
32    is( $p->url,          'http://www.perl.com/CPAN/modules/02packages.details.txt', 'url' );
33    is( $p->description,  'Package names found in directory $CPAN/authors/id/',      'description' );
34    is( $p->columns,      'package name, version, path',                             'columns' );
35    is( $p->intended_for, 'Automated fetch routines, namespace documentation.',      'intended for' );
36    is( $p->written_by,   'Id: mldistwatch 479 2004-01-04 13:29:05Z k ',             'written by' );
37    is( $p->line_count,   23609,                                                     'line count' );
38    is( $p->last_updated, 'Fri, 13 Feb 2004 13:50:21 GMT',                           'last updated' );
39
40    my $m = $p->package( "Acme::Colour" );
41    is( $m->package, "Acme::Colour" );
42    is( $m->version, "1.00" );
43
44    my $d = $m->distribution;
45    is( $d->prefix,    "L/LB/LBROCARD/Acme-Colour-1.00.tar.gz" );
46    is( $d->dist,      "Acme-Colour" );
47    is( $d->version,   "1.00" );
48    is( $d->maturity,  "released" );
49    is( $d->filename,  "Acme-Colour-1.00.tar.gz" );
50    is( $d->cpanid,    "LBROCARD" );
51    is( $d->distvname, "Acme-Colour-1.00" );
52
53    is( $p->package( "accessors::chained" )->distribution->dist, "accessors", "accessors::chained lives in accessors" );
54
55    is( $p->package( "accessors::classic" )->distribution->dist, "accessors", "as does accessors::classic" );
56
57    is( $p->package( "accessors::chained" )->distribution, $p->package( "accessors::classic" )->distribution, "and they're using the same distribution object" );
58
59    my $dist = $p->distribution( 'S/SP/SPURKIS/accessors-0.02.tar.gz' );
60    is( $dist->dist, 'accessors' );
61    is( $dist, $p->package( "accessors::chained" )->distribution, "by path match by name" );
62
63    is_deeply( [ map { $_->package } $dist->contains ], [qw( accessors accessors::chained accessors::classic )], "dist contains packages" );
64
65    $d = $p->latest_distribution( "Acme-Colour" );
66    is( $d->prefix,  "L/LB/LBROCARD/Acme-Colour-1.00.tar.gz" );
67    is( $d->version, "1.00" );
68
69    is_deeply(
70        [ sort map { $_->prefix } $p->latest_distributions ],
71        [
72            'A/AU/AUTRIJUS/Acme-ComeFrom-0.07.tar.gz', 'K/KA/KANE/Acme-Comment-1.02.tar.gz', 'L/LB/LBROCARD/Acme-Colour-1.00.tar.gz', 'S/SM/SMUELLER/Acme-Currency-0.01.tar.gz',
73            'S/SP/SPURKIS/accessors-0.02.tar.gz',      'X/XE/XERN/Acme-CramCode-0.01.tar.gz',
74        ]
75    );
76
77    # counts
78    is( $p->package_count,             scalar @packages, "package count" );
79    is( $p->distribution_count,        7,                "dist count" );
80    is( $p->latest_distribution_count, 6,                "latest dist count" );
81
82    return;
83}
84
85sub dist_contents {
86    my ( $p ) = creation_check( @_ );
87
88    my $test_dist = $p->dists->{"K/KA/KANE/Acme-Comment-1.02.tar.gz"};
89    my $file      = "Acme-Comment-1.02/lib/Acme/Comment.pm";
90    is( ( $test_dist->list_files )[0], $file, "listing files in dists works" );
91
92    my $test_pkg = $p->data->{"Acme::Comment"};
93    is( $test_pkg->filename,                        $file, "a package can generate a good guess file name" );
94    is( $test_dist->get_file_from_tarball( $file ), "moo", "getting the content of a file in a dist works" );
95    is( $test_pkg->file_content,                    "moo", "a package can provide the content of its file" );
96
97    return;
98}
99
100sub creation_check {
101    my $reason = pop;
102    my $p = eval { Parse::CPAN::Packages->new( @_ ) };
103    is( $@, "", "no errors from the eval" );
104    isa_ok( $p, "Parse::CPAN::Packages" );
105
106    my @packages = sort map { $_->package } $p->packages;
107    is_deeply( \@packages, default_packages(), $reason );
108
109    return ( $p, @packages );
110}
111
112sub default_packages {
113    return [qw(Acme::Colour Acme::Colour::Old Acme::ComeFrom Acme::Comment Acme::CramCode Acme::Currency accessors accessors::chained accessors::classic )];
114}
115