File Coverage

blib/lib/Metabase/Resource/cpan/distfile.pm
Criterion Covered Total %
statement 40 41 97.5
branch 5 10 50.0
condition 1 5 20.0
subroutine 10 10 100.0
pod 1 1 100.0
total 57 67 85.0


line stmt bran cond sub pod time code
1 6     6   76 use 5.006;
  6         14  
2 6     6   21 use strict;
  6         6  
  6         96  
3 6     6   17 use warnings;
  6         9  
  6         201  
4              
5             package Metabase::Resource::cpan::distfile;
6              
7             our $VERSION = '0.025';
8              
9 6     6   19 use Carp ();
  6         4  
  6         63  
10 6     6   2273 use CPAN::DistnameInfo ();
  6         4086  
  6         99  
11              
12 6     6   60 use Metabase::Resource::cpan;
  6         6  
  6         1675  
13             our @ISA = qw/Metabase::Resource::cpan/;
14              
15             sub _metadata_types {
16             return {
17 1     1   12 cpan_id => '//str',
18             dist_file => '//str',
19             dist_name => '//str',
20             dist_version => '//str',
21             };
22             }
23              
24             sub _init {
25 34     34   36 my ($self) = @_;
26              
27             # determine subtype
28 34         444 my ($string) = $self =~ m{\Acpan:///distfile/(.+)\z};
29 34 50 33     117 Carp::confess("could not determine distfile from '$self'\n")
30             unless defined $string && length $string;
31              
32 34         46 my $data = $self->_validate_distfile($string);
33 34         62 for my $k ( keys %$data ) {
34 136         225 $self->_add( $k => $data->{$k} );
35             }
36 34         75 return $self;
37             }
38              
39             # distfile validates during _init, really
40 34     34 1 43 sub validate { 1 }
41              
42             # XXX should really validate AUTHOR/DISTNAME-DISTVERSION.SUFFIX
43             # -- dagolden, 2010-01-27
44             #
45             # my $suffix = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip)};
46             #
47             # for now, we'll use CPAN::DistnameInfo;
48             #
49              
50             # map DistnameInfo calls to our names
51             my %distfile_map = (
52             cpanid => 'cpan_id',
53             dist => 'dist_name',
54             version => 'dist_version',
55             );
56              
57             sub _validate_distfile {
58 34     34   32 my ( $self, $string ) = @_;
59 34         46 my $two = substr( $string, 0, 2 );
60 34         33 my $one = substr( $two, 0, 1 );
61 34         68 my $path = "authors/id/$one/$two/$string";
62 34         32 my $d = eval { CPAN::DistnameInfo->new($path) };
  34         77  
63 34 50       1589 my $bad = defined $d ? 0 : 1;
64              
65 34         54 my $cache = { dist_file => $string };
66              
67 34 50       90 for my $k ( $bad ? () : ( keys %distfile_map ) ) {
68 102         186 my $value = $d->$k;
69 102 50 0     287 defined $value or $bad++ and last;
70 102         165 $cache->{ $distfile_map{$k} } = $value;
71             }
72              
73 34 50       56 if ($bad) {
74 0         0 Carp::confess("'$string' can't be parsed as a CPAN distfile");
75             }
76 34         108 return $cache;
77             }
78              
79             1;
80              
81             # ABSTRACT: class for Metabase resources
82              
83             __END__