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