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

package Net::FreeDB2::Response::Query;

# Copyright 2002, Vincenzo Zocca.

# See LICENSE section for usage and distribution rights.

require 5.005_62;
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);
use Error qw (:try);
use base qw (Net::FreeDB2::Response Exporter);

#our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::FreeDB2::Response::Query ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our ( $VERSION ) = '$Revision: 0.8.2.3 $ ' =~ /\$Revision:\s+([^\s]+)/;

my $CODE_RX = '^\s*(\d{3})\s+';
my $EXACT_MATCH_RX = $CODE_RX . '(\S+)\s+(\S+)\s+(.*)\s*$';
my $INEXACT_MATCH_RX = '^\s*(\S+)\s+(\S+)\s+(.*)\s*$';

sub new {
	my $class = shift;

	my $self = {};
	bless ($self, (ref($class) || $class));
	return ($self->_initialize (@_));
}

sub _initialize {
	my $self = shift;
	my $opt = shift || {};

	defined ($opt->{content_ref}) and $self->read ($opt);
	return ($self);
}

sub read {
	my $self = shift;
	my $opt = shift || {};

	# Check if content_ref is specified
	exists ($opt->{content_ref}) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Query::read, option \'content_ref\' not defined.');

	# Convert $opt->{content_ref} to @content_ref
	my @content_ref = split (/[\n\r]+/, ${$opt->{content_ref}});

	# Parse first line
	my $line = shift (@content_ref);
	my ($code) = $line =~ /$CODE_RX/;
	defined ($code) || throw Error::Simple ('ERROR: Net::FreeDB2::Response::Query::read, first line of specified \'content_ref\' does not contain a code.');
	if ($code == 200) {
		my ($code, $categ, $discid, $dtitle) = $line =~ /$EXACT_MATCH_RX/;
		use Net::FreeDB2::Match;
		$self->setMatches (Net::FreeDB2::Match->new ({
			categ => $categ,
			discid => $discid,
			dtitle => $dtitle,
		}));
		$self->setError (0);
		$self->setResult ('Found exact match');
	} elsif ($code == 211) {
		my @matches = ();
		while (my $line = shift (@content_ref)) {
			$line eq '.' && last;
			$line =~ /^\s*.\s*$/ && last;
			my ($categ, $discid, $dtitle) = $line =~ /$INEXACT_MATCH_RX/;
			use Net::FreeDB2::Match;
			push (@matches, Net::FreeDB2::Match->new ({
				categ => $categ,
				discid => $discid,
				dtitle => $dtitle,
			}));
		}
		$self->setMatches (@matches);
		$self->setError (0);
		$self->setResult ('Found inexact matches');
	} elsif ($code == 202) {
		$self->setMatches ();
		$self->setError (0);
		$self->setResult ('No match found');
	} elsif ($code == 403) {
		$self->setError (1);
		$self->setResult ('Database entry is corrupt');
	} elsif ($code == 409) {
		$self->setError (1);
		$self->setResult ('No handshake');
	} else {
		throw Error::Simple ("ERROR: Net::FreeDB2::Response::Query::read, unknown code '$code' returned.");
	}
}

sub setMatches {
	my $self = shift;

	@{$self->{Net_FreeDB2_Response_Query}{matches}} = @_;
}

sub pushMatches {
	my $self = shift;

	push (@{$self->{Net_FreeDB2_Response_Query}{matches}}, @_);
}

sub getMatches {
	my $self = shift;

	return (@{$self->{Net_FreeDB2_Response_Query}{matches}});
}

1;
__END__