File Coverage

/.cpan/build/Net-FreeDB2-0.8.2.6-xK8Ulr/blib/lib/Net/FreeDB2/Response/Read.pm
Criterion Covered Total %
statement 18 53 33.9
branch 0 16 0.0
condition 0 7 0.0
subroutine 6 11 54.5
pod 4 4 100.0
total 28 91 30.7


line stmt bran cond sub pod time code
1             package Net::FreeDB2::Response::Read;
2              
3             # Copyright 2002, Vincenzo Zocca.
4              
5             # See LICENSE section for usage and distribution rights.
6              
7             require 5.005_62;
8 3     3   17 use strict;
  3         5  
  3         117  
9 3     3   17 use warnings;
  3         6  
  3         123  
10              
11             require Exporter;
12 3     3   866 use AutoLoader qw(AUTOLOAD);
  3         1694  
  3         21  
13 3     3   1099 use Error qw (:try);
  3         7241  
  3         17  
14 3     3   556 use base qw (Net::FreeDB2::Response Exporter);
  3         7  
  3         1830  
15              
16             #our @ISA = qw(Exporter);
17              
18             # Items to export into callers namespace by default. Note: do not export
19             # names by default without a very good reason. Use EXPORT_OK instead.
20             # Do not simply export all your public functions/methods/constants.
21              
22             # This allows declaration use Net::FreeDB2::Response::Read ':all';
23             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
24             # will save memory.
25             our %EXPORT_TAGS = ( 'all' => [ qw(
26            
27             ) ] );
28              
29             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
30              
31             our @EXPORT = qw(
32            
33             );
34             our ( $VERSION ) = '$Revision: 0.8.2.3 $ ' =~ /\$Revision:\s+([^\s]+)/;
35              
36             my $CODE_RX = '^\s*(\d{3})\s+';
37             my $EXACT_MATCH_RX = $CODE_RX . '(\S+)\s+(\S+)\s+(.*)\s*$';
38              
39             sub new {
40 0     0 1   my $class = shift;
41              
42 0           my $self = {};
43 0   0       bless ($self, (ref($class) || $class));
44 0           return ($self->_initialize (@_));
45             }
46              
47             sub _initialize {
48 0     0     my $self = shift;
49 0   0       my $opt = shift || {};
50              
51 0 0         defined ($opt->{content_ref}) and $self->read ($opt);
52 0           return ($self);
53             }
54              
55             sub read {
56 0     0 1   my $self = shift;
57 0   0       my $opt = shift || {};
58              
59             # Check if content_ref is specified
60 0 0         exists ($opt->{content_ref}) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Read::read, option \'content_ref\' not defined.');
61              
62             # Convert $opt->{content_ref} to @content_ref
63 0           my @content_ref = split (/[\n\r]+/, ${$opt->{content_ref}});
  0            
64              
65             # Parse first line
66 0           my $line = shift (@content_ref);
67 0           my ($code) = $line =~ /$CODE_RX/;
68 0 0         defined ($code) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Read::read, first line of specified \'content_ref\' does not contain a code.');
69 0 0         if ($code == 210) {
    0          
    0          
    0          
    0          
70 0           my ($code, $categ, $discid, $dtitle) = $line =~ /$EXACT_MATCH_RX/;
71 3     3   501 use Net::FreeDB2::Match;
  3         7  
  3         1118  
72 0           $self->setEntry (Net::FreeDB2::Entry->new ({
73             array_ref => \@content_ref,
74             }));
75 0           $self->setError (0);
76 0           $self->setResult ('OK');
77             } elsif ($code == 401) {
78 0           $self->setEntry ();
79 0           $self->setError (0);
80 0           $self->setResult ('Specified CDDB entry not found');
81             } elsif ($code == 402) {
82 0           $self->setError (1);
83 0           $self->setResult ('Server error');
84             } elsif ($code == 403) {
85 0           $self->setError (1);
86 0           $self->setResult ('Database entry is corrupt');
87             } elsif ($code == 409) {
88 0           $self->setError (1);
89 0           $self->setResult ('No handshake');
90             } else {
91 0           throw Error::Simple ("ERROR: Net::FreeDB2::Response::Read::read, unknown code '$code' returned.");
92             }
93             }
94              
95             sub setEntry {
96 0     0 1   my $self = shift;
97              
98 0           $self->{Net_FreeDB2_Response_Read}{entry} = shift;
99             }
100              
101             sub getEntry {
102 0     0 1   my $self = shift;
103              
104 0           return ($self->{Net_FreeDB2_Response_Read}{entry});
105             }
106              
107             1;
108             __END__