File Coverage

/.cpan/build/Net-FreeDB2-0.8.2.6-xK8Ulr/blib/lib/Net/FreeDB2/Connection/HTTP.pm

Criterion	Covered	Total	%
statement	30	131	22.9
branch	0	34	0.0
condition	0	12	0.0
subroutine	10	32	31.2
pod	20	21	95.2
total	60	230	26.0

package Net::FreeDB2::Connection::HTTP;

# Copyright 2002, Vincenzo Zocca.

# See LICENSE section for usage and distribution rights.

require 5.005_62;
use strict;
use warnings;
use Error qw (:try);

require Exporter;
use AutoLoader qw(AUTOLOAD);

#our @ISA = qw(Net::FreeDB2::Connection Exporter);
use base qw (Net::FreeDB2::Connection 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::Connection::HTTP ':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]+)/;

sub new {
	# Call constructor of super class
	my $self = &Net::FreeDB2::Connection::new (@_);

	# Shift out this class specification
	shift;

	# Return object
	return ($self);
}

sub _initialize {
	my $self = shift;

	# Get options
	my $opt = shift || {};

	# Set freedb_cgi
	$self->setFreeDBCgi ($opt->{freedb_cgi} || '~cddb/cddb.cgi');

	# Initialize super class
	return ($self->SUPER::_initialize ($opt));
}

sub hello {
}

sub lscat {
	my $self = shift;

	# Send command and wait for reply
	my $content_ref = $self->waitCommandReply ('?cmd=cddb+lscat', {
		210 => 1,
	});

	# Parse the result
	my @content = split (/[\n\r]+/, ${$content_ref});
	my $head = shift (@content);
	my @cat = ();
	foreach my $cat (@content) {
		last if ($cat eq '.');
		push (@cat, $cat);
	}
	return (@cat);
}

sub query {
	my $self = shift;
	my $entity = shift;

	# Send command and wait for reply
	my $query = $entity->mkQuery ();
	$query =~ s/\s+/+/g;
	my $cmd = '?cmd=cddb+query+' . $query;
	my $content_ref = $self->waitCommandReply ($cmd, {
		200 => 1,
		211 => 1,
		202 => 1,
		403 => 1,
		409 => 1,
	});

	# Parse the result
	use Net::FreeDB2::Response::Query;
	return Net::FreeDB2::Response::Query->new ({
		content_ref => $content_ref,
	});
}

sub read {
	my $self = shift;
	my $match = shift;

	# Send command and wait for reply
	my $cmd = '?cmd=cddb+read+' . $match->getCateg () . '+' . $match->getDiscid ();
	my $content_ref = $self->waitCommandReply ($cmd, {
		200 => 1,
		211 => 1,
		202 => 1,
		403 => 1,
		409 => 1,
	});

	# Parse the result
	use Net::FreeDB2::Response::Read;
	return Net::FreeDB2::Response::Read->new ({
		content_ref => $content_ref,
	});
}

sub write {
	throw Error::Simple ("ERROR: Net::FreeDB2::Connection::HTTP::write, command not supported under HTTP.");
}

sub log {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::log, to be implemented.");
}

sub motd {
	my $self = shift;

	# Send command and wait for reply
	my $content_ref = $self->waitCommandReply ('?cmd=motd', {
		210 => 1,
		401 => 1,
	});

	# Parse the result
	my @content = split (/[\n\r]+/, ${$content_ref});
	my $head = shift (@content);
	my @motd = ();
	foreach my $motd (@content) {
		last if ($motd eq '.');
		push (@motd, $motd);
	}
	return (@motd);
}

sub discid {
	my $self = shift;
	my $entity = shift;

	# Send command and wait for reply
	my $discid = $entity->mkQuery ();
	$discid =~ s/^\s*\S+\s+//;
	$discid =~ s/\s+/+/g;
	my $cmd = '?cmd=discid+' . $discid;
	my $content_ref = $self->waitCommandReply ($cmd, {
		200 => 1,
		500 => 1,
	});

	# Parse the result
	my @content = split (/[\n\r]+/, ${$content_ref});
	my $head = shift (@content);
	my ($code) = $head =~ /^\s*(\d{3})\s+/;
	$code == 200 || $code == 500 || throw Error::Simple ("ERROR: Net::FreeDB2::Connection::HTTP::discid, unknown code '$code' returned.");
	$code == 500 && throw Error::Simple ("ERROR: Net::FreeDB2::Connection::HTTP::discid, Command Syntax error.");
	my @head = split (/\s+/, $head);
	return ($head[4]);
}

sub proto {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::proto, to be implemented.");
}

sub sites {
	my $self = shift;

	# Send command and wait for reply
	my $content_ref = $self->waitCommandReply ('?cmd=sites', {
		200 => 1,
		500 => 1,
	});

	# Parse the result
	use Net::FreeDB2::Response::Sites;
	return Net::FreeDB2::Response::Sites->new ({
		content_ref => $content_ref,
	});
}

sub stat {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::stat, to be implemented.");
}

sub ver {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::ver, to be implemented.");
}

sub update {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::update, to be implemented.");
}

sub whom {
	throw Error::Simple ("ERROR: Net::FreeDB2::HTTP::whom, to be implemented.");
}

sub connect {
	my $self = shift;

	# Make connection through user agent
	use LWP::UserAgent;
	my $connection = LWP::UserAgent->new ();
	defined ($connection) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::connect, Failed to instanciate an \'LWP::UserAgent\' object.');
	$self->setConnection ($connection);

	# Set proxy if required
	defined ($self->getProxyHost ()) || return;
	my $url =  'http://' . $self->getProxyHost() . ':' . ($self->getProxyPort () || 8080);
	$connection->proxy ('http', $url);
}

sub waitCommandReply {
        my $self = shift;
        my $cmd = shift;
        my $rx = shift;

	# Check if connection is defined
	defined ($self->getConnection ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::waitCommandReply, no connection available.');

	# Make url
	my $url = $self->mkUrlBase ();
	$url .= $cmd . $self->mkHello ();

	# Make request
	use HTTP::Request;
	my $request = HTTP::Request->new (GET => $url);
	defined ($request) || throw Error::Simple ("ERROR: Net::FreeDB2::Connection::HTTP::waitCommandReply, failed to make HTTP::Request object out of url '$url'.");

	# Set proxy authorization if required
	if ($self->getProxyHost () && $self->getProxyUser ()) {
		$request->proxy_authorization_basic ($self->getProxyUser (), $self->getProxyPasswd ());
	}

	# Execute the request through the connection
	my $response = $self->getConnection ()->simple_request ($request);
	$response->is_success() || throw Error::Simple ("ERROR: Net::FreeDB2::Connection::HTTP::waitCommandReply, failed to execute request for url '$url'.");


        # Return the content reference
        return ($response->content_ref ());
}

sub mkHello {
	my $self = shift;

	defined ($self->getClientName ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkHello, \'client_name\' not set.');
	defined ($self->getClientVersion ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkHello, \'client_version\' not set.');
	defined ($self->getClientHost ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkHello, \'client_host\' not set.');
	defined ($self->getClientUser ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkHello, \'client_user\' not set.');

	return ('&hello=' . join ('+',
		$self->getClientUser (),
		$self->getClientHost (),
		$self->getClientName (),
		$self->getClientVersion (),
		) .
		'&proto=1'
	);
}

sub mkUrlBase {
	my $self = shift;

	defined ($self->getFreeDBHost ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkUrlBase, \'freedb_host\' not set.');
	defined ($self->getFreeDBCgi ()) || throw Error::Simple ('ERROR: Net::FreeDB2::Connection::HTTP::mkUrlBase, \'freedb_cgi\' not set.');
	my $url = 'http://' .  $self->getFreeDBHost ();
	$url .= ':' . $self->getFreeDBPort () if ($self->getFreeDBPort ());
	$url .= '/' . $self->getFreeDBCgi ();
}

sub setFreeDBCgi {
	my $self = shift;

	# Set freedb/cddb url
	$self->{Net_FreeDB2_Connection_HTTP}{freedb_cgi} = shift;
}

sub getFreeDBCgi {
	my $self = shift;

	# Return freedb/cddb url
	return ($self->{Net_FreeDB2_Connection_HTTP}{freedb_cgi});
}

1;
__END__