File Coverage

blib/lib/JSAN/Indexer.pm
Criterion Covered Total %
statement 34 73 46.5
branch 1 12 8.3
condition 3 12 25.0
subroutine 11 17 64.7
pod 1 2 50.0
total 50 116 43.1


line stmt bran cond sub pod time code
1             package JSAN::Indexer;
2 1     1   5 use strict;
  1         2  
  1         39  
3 1     1   5 use warnings;
  1         3  
  1         32  
4              
5 1     1   730 use Class::DBI::Loader;
  1         266  
  1         27  
6 1     1   488 use JSAN::Indexer::Creator;
  1         4  
  1         23  
7 1     1   40 use YAML;
  1         2  
  1         54  
8 1     1   6 use base qw[Class::Accessor::Fast];
  1         3  
  1         856  
9             __PACKAGE__->mk_accessors(qw[loader author distribution release library]);
10              
11             our $VERSION = '0.05';
12             our $LOADER;
13             our $DSN;
14             our $INDEX_DB;
15              
16             sub import {
17 2     2   551 my ($class, $index_db) = @_;
18 2 50       9 $INDEX_DB = $index_db if $index_db;
19 2   33     17 $INDEX_DB ||= $ENV{JSAN_INDEX_DB}
      66        
20             || "$ENV{HOME}/.jsan.index.sqlite";
21 2         43 $DSN = "dbi:SQLite:$INDEX_DB";
22             }
23              
24             sub new {
25 0     0 1   my ($class) = shift;
26 0           $LOADER = Class::DBI::Loader->new(
27             dsn => $DSN,
28             namespace => "JSAN::Indexer",
29             relationships => 1,
30             );
31 0           my $self = $class->SUPER::new({@_});
32 0           $self->loader($LOADER);
33 0           $self->_class_map;
34 0           eval { $self->_relate };
  0            
35 0           return $self;
36             }
37              
38             sub create_index_db {
39 0     0 0   my ($class) = shift;
40 0           JSAN::Indexer::Creator->create_index_db($class, $DSN, $INDEX_DB, @_);
41             }
42              
43             sub _class_map {
44 0     0     my ($self) = @_;
45             $self->$_($self->loader->find_class($_))
46 0           for qw[author distribution release library];
47             }
48              
49             sub _relate {
50 0     0     my ($self) = @_;
51            
52 0           my @rel = (
53             q[author has_many distributions distribution],
54             q[distribution has_many releases release],
55             q[distribution has_many libraries library],
56             q[release has_a distribution],
57             q[release has_a author],
58             q[release has_many libraries library],
59             q[library has_a distribution],
60             q[library has_a release],
61             );
62            
63 0           foreach my $rel ( @rel ) {
64 0           my ($class, $type, $col, $foreign) = split /\s+/, $rel;
65 0   0       $foreign ||= $col;
66              
67              
68 0 0 0       unless ($type eq 'has_many' && UNIVERSAL::can($self->loader->find_class($class), $col) ) {
69 0           eval { $self->loader->find_class($class)->$type($col => $self->loader->find_class($foreign)) };
  0            
70 0 0         warn $@ if $@;
71             }
72             }
73            
74 0           $self->release->has_a(meta => 'JSAN::Indexer::Meta');
75             }
76              
77             package JSAN::Indexer::Meta;
78 1     1   7 use strict;
  1         3  
  1         86  
79 1     1   6 use warnings;
  1         1  
  1         35  
80              
81 1     1   5 use YAML;
  1         2  
  1         69  
82 1     1   28 use base qw[Class::Accessor::Fast];
  1         2  
  1         333  
83              
84             __PACKAGE__->mk_accessors(qw[yaml _meta]);
85             sub new {
86 0     0     my ($class, $meta) = @_;
87 0           return $class->SUPER::new({yaml => $meta, _meta => Load($meta)});
88             }
89              
90             sub requires {
91 0     0     my ($self) = @_;
92 0 0         return [] unless $self->_meta;
93 0           my $req = $self->_meta->{requires};
94 0           my $build = $self->_meta->{build_requires};
95              
96 0           my %reqs;
97 0 0         if (ref($build) eq 'HASH') {
98 0           $reqs{$_} = $build->{$_} for keys %{$build};
  0            
99             }
100 0 0         if (ref($req) eq 'HASH') {
101 0           $reqs{$_} = $req->{$_} for keys %{$req};
  0            
102             }
103              
104 0           my @reqs;
105 0           while (my ($k, $v) = each %reqs) {
106 0           push @reqs, {
107             name => $k,
108             version => $v,
109             };
110             }
111 0           return \@reqs;
112             }
113              
114             1;
115              
116             __END__