File Coverage

blib/lib/CPANDB.pm
Criterion Covered Total %
statement 24 83 28.9
branch 0 10 0.0
condition 0 6 0.0
subroutine 8 17 47.0
pod 0 8 0.0
total 32 124 25.8


line stmt bran cond sub pod time code
1             package CPANDB;
2              
3 1     1   867 use 5.008005;
  1         4  
  1         43  
4 1     1   6 use strict;
  1         3  
  1         34  
5 1     1   16 use warnings;
  1         3  
  1         32  
6 1     1   1321 use IO::File ();
  1         13273  
  1         26  
7 1     1   7359 use DateTime 0.55 ();
  1         282550  
  1         151  
8 1     1   13 use Params::Util 1.00 ();
  1         25  
  1         22  
9 1     1   5353 use ORLite 1.51 ();
  1         86993  
  1         39  
10 1     1   1677 use ORLite::Mirror 1.20 ();
  1         201181  
  1         1395  
11              
12             our $VERSION = '0.18';
13             our @LOCATION = (
14             locale => 'C',
15             time_zone => 'UTC',
16             );
17              
18             sub import {
19 0     0     my $class = shift;
20 0   0       my $params = Params::Util::_HASH(shift) || {};
21              
22             # Pass through any params from above
23 0   0       $params->{url} ||= 'http://svn.ali.as/db/cpandb.bz2';
24 0   0       $params->{maxage} ||= 24 * 60 * 60; # One day
25              
26             # Always turn on string eval debugging if Perl is new enough
27 0 0         if ( $^V > 5.008008 ) {
28 0           $^P = $^P | 0x800;
29             }
30              
31             # Prevent double-initialisation
32 0 0         $class->can('orlite') or
33             ORLite::Mirror->import( $params );
34              
35 0           return 1;
36             }
37              
38             sub latest {
39 0     0 0   my $class = shift;
40              
41             # Find the distribution most recently uploaded
42 0           my @latest = CPANDB::Distribution->select(
43             'ORDER BY uploaded DESC LIMIT 1',
44             );
45 0 0         unless ( @latest == 1 ) {
46 0           die "Unexpected number of uploads";
47             }
48              
49             # When was it?
50 0           return $latest[0]->uploaded;
51             }
52              
53             sub latest_datetime {
54 0     0 0   my $class = shift;
55 0           my @latest = split /\D+/, $class->latest;
56 0           return DateTime->new(
57             year => $latest[0],
58             month => $latest[1],
59             day => $latest[2],
60             @LOCATION,
61             );
62             }
63              
64             sub age {
65 0     0 0   my $class = shift;
66 0           my $latest = $class->latest_datetime;
67 0           my $today = DateTime->today( @LOCATION );
68 0           my $duration = $today - $latest;
69 0           return $duration->in_units('days');
70             }
71              
72             sub distribution {
73 0     0 0   my $self = shift;
74 0           my @dist = CPANDB::Distribution->select(
75             'where distribution = ?', $_[0],
76             );
77 0 0         unless ( @dist ) {
78 0           die("Distribution '$_[0]' does not exist");
79             }
80 0           return $dist[0];
81             }
82              
83             sub graph {
84 0     0 0   require Graph;
85 0           require Graph::Directed;
86 0           my $class = shift;
87 0           my $graph = Graph::Directed->new;
88 0           foreach my $vertex ( CPANDB::Distribution->select ) {
89 0           $graph->add_vertex( $vertex->distribution );
90             }
91 0           foreach my $edge ( CPANDB::Dependency->select ) {
92 0           $graph->add_edge( $edge->distribution => $edge->dependency );
93             }
94 0           return $graph;
95             }
96              
97             sub easy {
98 0     0 0   require Graph::Easy;
99 0           my $class = shift;
100 0           my $graph = Graph::Easy->new;
101 0           foreach my $vertex ( CPANDB::Distribution->select ) {
102 0           $graph->add_vertex( $vertex->distribution );
103             }
104 0           foreach my $edge ( CPANDB::Dependency->select ) {
105 0           $graph->add_edge( $edge->distribution => $edge->dependency );
106             }
107 0           return $graph;
108             }
109              
110             sub xgmml {
111 0     0 0   require Graph::XGMML;
112 0           my $class = shift;
113 0 0         my @param = ( @_ == 1 ) ? ( OUTPUT => IO::File->new( shift, 'w' ) ) : ( @_ );
114 0           my $graph = Graph::XGMML->new( directed => 1, @param );
115 0           foreach my $vertex ( CPANDB::Distribution->select ) {
116 0           $graph->add_vertex( $vertex->distribution );
117             }
118 0           foreach my $edge ( CPANDB::Dependency->select ) {
119 0           $graph->add_edge( $edge->distribution => $edge->dependency );
120             }
121 0           $graph->end;
122 0           return 1;
123             }
124              
125             sub csv {
126 0     0 0   my $class = shift;
127 0           my $file = shift;
128 0           my $csv = IO::File->new($file, 'w');
129 0           foreach my $edge ( CPANDB::Dependency->select ) {
130 0           $csv->print( $edge->distribution . "\t" . $edge->dependency . "\n" );
131             }
132 0           $csv->close;
133             }
134              
135             1;