File Coverage

/.cpan/build/Net-FreeDB2-0.8.2.6-xK8Ulr/blib/lib/Net/FreeDB2/Response/Query.pm
Criterion Covered Total %
statement 21 68 30.8
branch 0 20 0.0
condition 0 7 0.0
subroutine 7 13 53.8
pod 5 5 100.0
total 33 113 29.2


line stmt bran cond sub pod time code
1             package Net::FreeDB2::Response::Query;
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   15 use strict;
  3         4  
  3         106  
9 3     3   18 use warnings;
  3         3  
  3         115  
10              
11             require Exporter;
12 3     3   1023 use AutoLoader qw(AUTOLOAD);
  3         2496  
  3         23  
13 3     3   870 use Error qw (:try);
  3         11162  
  3         21  
14 3     3   980 use base qw (Net::FreeDB2::Response Exporter);
  3         7  
  3         1737  
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::Query ':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             my $INEXACT_MATCH_RX = '^\s*(\S+)\s+(\S+)\s+(.*)\s*$';
39              
40             sub new {
41 0     0 1   my $class = shift;
42              
43 0           my $self = {};
44 0   0       bless ($self, (ref($class) || $class));
45 0           return ($self->_initialize (@_));
46             }
47              
48             sub _initialize {
49 0     0     my $self = shift;
50 0   0       my $opt = shift || {};
51              
52 0 0         defined ($opt->{content_ref}) and $self->read ($opt);
53 0           return ($self);
54             }
55              
56             sub read {
57 0     0 1   my $self = shift;
58 0   0       my $opt = shift || {};
59              
60             # Check if content_ref is specified
61 0 0         exists ($opt->{content_ref}) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Query::read, option \'content_ref\' not defined.');
62              
63             # Convert $opt->{content_ref} to @content_ref
64 0           my @content_ref = split (/[\n\r]+/, ${$opt->{content_ref}});
  0            
65              
66             # Parse first line
67 0           my $line = shift (@content_ref);
68 0           my ($code) = $line =~ /$CODE_RX/;
69 0 0         defined ($code) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Query::read, first line of specified \'content_ref\' does not contain a code.');
70 0 0         if ($code == 200) {
    0          
    0          
    0          
    0          
71 0           my ($code, $categ, $discid, $dtitle) = $line =~ /$EXACT_MATCH_RX/;
72 3     3   1568 use Net::FreeDB2::Match;
  3         9  
  3         585  
73 0           $self->setMatches (Net::FreeDB2::Match->new ({
74             categ => $categ,
75             discid => $discid,
76             dtitle => $dtitle,
77             }));
78 0           $self->setError (0);
79 0           $self->setResult ('Found exact match');
80             } elsif ($code == 211) {
81 0           my @matches = ();
82 0           while (my $line = shift (@content_ref)) {
83 0 0         $line eq '.' && last;
84 0 0         $line =~ /^\s*.\s*$/ && last;
85 0           my ($categ, $discid, $dtitle) = $line =~ /$INEXACT_MATCH_RX/;
86 3     3   21 use Net::FreeDB2::Match;
  3         5  
  3         1155  
87 0           push (@matches, Net::FreeDB2::Match->new ({
88             categ => $categ,
89             discid => $discid,
90             dtitle => $dtitle,
91             }));
92             }
93 0           $self->setMatches (@matches);
94 0           $self->setError (0);
95 0           $self->setResult ('Found inexact matches');
96             } elsif ($code == 202) {
97 0           $self->setMatches ();
98 0           $self->setError (0);
99 0           $self->setResult ('No match found');
100             } elsif ($code == 403) {
101 0           $self->setError (1);
102 0           $self->setResult ('Database entry is corrupt');
103             } elsif ($code == 409) {
104 0           $self->setError (1);
105 0           $self->setResult ('No handshake');
106             } else {
107 0           throw Error::Simple ("ERROR: Net::FreeDB2::Response::Query::read, unknown code '$code' returned.");
108             }
109             }
110              
111             sub setMatches {
112 0     0 1   my $self = shift;
113              
114 0           @{$self->{Net_FreeDB2_Response_Query}{matches}} = @_;
  0            
115             }
116              
117             sub pushMatches {
118 0     0 1   my $self = shift;
119              
120 0           push (@{$self->{Net_FreeDB2_Response_Query}{matches}}, @_);
  0            
121             }
122              
123             sub getMatches {
124 0     0 1   my $self = shift;
125              
126 0           return (@{$self->{Net_FreeDB2_Response_Query}{matches}});
  0            
127             }
128              
129             1;
130             __END__