File Coverage

lib/Net/GNUDB/Cd.pm
Criterion Covered Total %
statement 51 57 89.4
branch 6 10 60.0
condition n/a
subroutine 12 12 100.0
pod 4 4 100.0
total 73 83 87.9


line stmt bran cond sub pod time code
1             package Net::GNUDB::Cd;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Net::GNUDB::Cd - Base class for L results.
8              
9             =head1 SYNOPSIS
10              
11             use Net::GNUDB::Cd;
12             my $config = {
13             'id' => '950cc10c',
14             'genre' => 'misc'
15             }
16             my $cd = Net::GNUDB::Cd->new($config);
17             my $id = $cd->getId();
18             my $genre = $cd->getGenre();
19             my $tracks = $cd->getTracks();
20              
21             =head1 DESCRIPTION
22              
23             Base class for L results, normally not instantiated directly but can used to lookup a specific GNUDB entry.
24              
25             =head1 METHODS
26              
27             =cut
28              
29 4     4   15673 use warnings;
  4         5  
  4         97  
30 4     4   12 use strict;
  4         4  
  4         55  
31 4     4   12 use Carp;
  4         8  
  4         180  
32 4     4   1504 use Net::FreeDB2;
  4         23197  
  4         150  
33 4     4   1519 use Net::FreeDB2::Match;
  4         3165  
  4         140  
34 4     4   1749 use Net::FreeDB2::Entry; #see bug: https://rt.cpan.org/Ticket/Display.html?id=69089
  4         35643  
  4         1407  
35             #########################################################
36              
37             =head2 new($config)
38              
39             my $config = {
40             'id' => '950cc10c',
41             'genre' => 'misc'
42             }
43             my $cd = Net::GNUDB::Cd->new($config);
44              
45             Constructor, returns a new instance of the search CD object. Requires all two of the above elements in the provided hash reference for operation. These
46             elements must match a GNUDB entry.
47              
48             =cut
49              
50             #########################################################
51             sub new{
52 52     52 1 437 my($class, $config) = @_;
53 52         99 my $self = {
54             '__id' => undef,
55             '__genre' => undef,
56             '__tracks' => []
57             };
58 52         46 bless $self, $class;
59 52         66 $self->__setId($config->{'id'});
60 52         58 $self->__setGenre($config->{'genre'});
61 52         65 return $self;
62             }
63             ########################################################
64              
65             =head2 getTracks()
66              
67             my $tracks = $cd->getTracks()
68              
69             Returns an array reference of track names for the CD found from the details in the config given at object creation.
70              
71             This method actually performs the lookup to the GNUDB database.
72              
73             =cut
74              
75             ########################################################
76             sub getTracks{
77 4     4 1 1473 my $self = shift;
78 4         5 my @tracks = @{$self->{'__tracks'}};
  4         14  
79 4 100       17 if($#tracks == -1){
80 2         11 my $connectionConfig = {
81             client_name => ref($self),
82             client_version => 1.0,
83             protocol => "HTTP",
84             freedb_host => "gnudb.gnudb.org"
85             };
86 2         13 my $conn = Net::FreeDB2->connection($connectionConfig);
87 2         87400 my $matchConfig = {
88             "categ" => $self->getGenre(),
89             "discid" => $self->getId()
90             };
91 2         14 my $match = Net::FreeDB2::Match->new($matchConfig);
92 2         52 my $res = $conn->read($match);
93 2 50       456820 if($res->hasError()){
94 0         0 confess('Error quering GNUDB');
95             }
96             else{ #all ok
97 2         16 my $entry = $res->getEntry();
98 2         13 @tracks = $entry->getTtitlen(0); #get all tracks;
99 2         241 $self->{'__tracks'} = \@tracks;
100             }
101             }
102 4         100 return @tracks;
103             }
104             #########################################################
105              
106             =head2 getId()
107              
108             my $id = $cd->getId()
109              
110             Returns the same ID string as given in the config on object creation.
111              
112             =cut
113              
114             #########################################################
115             sub getId{
116 4     4 1 7 my $self = shift;
117 4         14 return $self->{'__id'};
118             }
119             #########################################################
120              
121             =head2 getGenre()
122              
123             my $genre = $cd->getGenre()
124              
125             Returns the same genre string as given in the config on object creation.
126              
127             =cut
128              
129             #########################################################
130             sub getGenre{
131 4     4 1 454 my $self = shift;
132 4         18 return $self->{'__genre'};
133             }
134             #########################################################
135             sub __setId{
136 52     52   27 my($self, $id) = @_;
137 52 50       52 if(defined($id)){
138 52 50       109 if($id =~ m/^[0-9a-fA-F]+$/){
139 52         55 $self->{'__id'} = $id;
140 52         43 return 1;
141             }
142             else{
143 0         0 confess("Invalid ID");
144             }
145             }
146             else{
147 0         0 confess("No ID given");
148             }
149 0         0 return 0;
150             }
151             #########################################################
152             sub __setGenre{
153 52     52   39 my($self, $genre) = @_;
154 52 50       54 if(defined($genre)){
155 52         46 $self->{'__genre'} = $genre;
156 52         35 return 1;
157             }
158             else{
159 0           confess("No genre given");
160             }
161 0           return 0;
162             }
163             #########################################################
164              
165             =pod
166              
167             =head1 Author
168              
169             MacGyveR
170              
171             Development questions, bug reports, and patches are welcome to the above address.
172              
173             =head1 Copyright
174              
175             Copyright (c) 2012 MacGyveR. All rights reserved.
176              
177             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
178              
179             =head1 See Also
180              
181             L
182              
183             =cut
184              
185             #########################################################
186             return 1;