File Coverage

blib/lib/Net/FreeDB.pm

Criterion	Covered	Total	%
statement	113	160	70.6
branch	26	64	40.6
condition	3	12	25.0
subroutine	26	41	63.4
pod	6	8	75.0
total	174	285	61.0

package Net::FreeDB;

use 5.006;
use strict;
use warnings;
use IO::Socket;
use Net::Cmd;
use CDDB::File;
use Carp;
use Data::Dumper;
use File::Temp;

require Exporter;
require DynaLoader;
use AutoLoader;

our @ISA = qw(Exporter DynaLoader Net::Cmd IO::Socket::INET);

# 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::FreeDB ':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 = '0.08';

our $ERROR;
sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "& not defined" if $constname eq 'constant';
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/ || $!{EINVAL}) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
	    croak "Your vendor has not defined Net::FreeDB macro $constname";
	}
    }
    {
	no strict 'refs';
	# Fixed between 5.005_53 and 5.005_61
	if ($] >= 5.00561) {
	    *$AUTOLOAD = sub () { $val };
	}
	else {
	    *$AUTOLOAD = sub { $val };
	}
    }
    goto &$AUTOLOAD;
}

bootstrap Net::FreeDB $VERSION;

# Preloaded methods go here.
sub new {
    my $class = shift;
    my $self = {};
    $self = {@_};
    bless($self, $class);

    $self->{HOST} = 'freedb.freedb.org' unless defined($self->{HOST});
    $self->{PORT} = '8880' unless defined($self->{PORT});

    if (!defined($self->{USER})) {
	$self->{USER} = defined($ENV{USER}) ? $ENV{USER} : 'unknown';
    }

    if (!defined($self->{HOSTNAME})) {
	$self->{HOSTNAME} = defined($ENV{HOSTNAME}) ? $ENV{HOSTNAME} : 'unknown';
    }

    my $obj = $self->SUPER::new(PeerAddr => $self->{HOST},
				PeerPort => $self->{PORT},
				Proto    => 'tcp',
				Timeout  =>
				defined($self->{TIMEOUT}) ? $self->{TIMEOUT} : 120
			       );

    return undef
      unless defined $obj;

    $obj->autoflush(1);
    $obj->debug(exists $self->{DEBUG} ? $self->{DEBUG} : undef);

    unless ($obj->response() == CMD_OK) {
	$obj->close;
	return undef;
    }

    $obj->command(
		  "cddb hello",
		  $self->{USER},
		  $self->{HOSTNAME},
		  ref($self),
		  $VERSION
		 );

    unless ($obj->response() == CMD_OK) {
	$obj->close;
	return undef;
    }

    $obj;
}

sub read {
    my $self = shift;
    my ($cat, $id);

    if (scalar(@_) == 2) {
	($cat, $id) = @_;
    } else {
	if ((scalar(@_) % 2) == 0) {
	    if ($_[0] =~ /^CATEGORY$/i || $_[0] =~ /^ID$/i) {
		my %input = @_;
		($cat, $id) = ($input{CATEGORY}, $input{ID});
	    } else {
		print "Error: Unknown input!\n";
		return undef;
	    }
	} else {
	    print "Error: Unknown input!\n";
	    return undef;
	}
    }

    # First, fetch the data, before creating any temporary files
    my $data = $self->_READ($cat, $id)? $self->_read(): undef;
    return undef unless defined $data;

    # Create a file for CDDB::File to use...
    my $fh = new File::Temp;
    print $fh join '', @$data;
    seek $fh, 0, 0;

    # ...and use it.
    my $cddb_file = new CDDB::File($fh->filename());
    return $cddb_file;
}

sub query {
    my $self = shift;
    $self->_QUERY(@_) ? $self->_query : undef;
}

sub sites {
    my $self = shift;
    $self->_SITES ? $self->_sites : undef;
}

sub getdiscid {
    my $self = shift;
	my ($driveNo, $id);
	if (ref($self) ne 'Net::FreeDB') {
		$driveNo = $self;
	} else {
		$driveNo = shift;
	}
	$id = discid($driveNo);
    if ($id eq "UNDEF" || $id eq '') {
	$ERROR = "Drive Error: no disc found\n";
	return undef;
    }
    return $id;
}

sub getdiscdata {
    my $self = shift;
    my ($driveNo, $data);
	if (ref($self) ne 'Net::FreeDB') {
		$driveNo = $self;
	} else {
		$driveNo = shift;
	}
	$data = discinfo($driveNo);
    if (!$data) {
	$ERROR = "Drive Error: no disc found\n";
	return undef;
    }
    return $data;
}

sub lscat {
    my $self = shift;
    $self->_LSCAT();
}
sub quit {
    my $self = shift;
    $self->_QUIT();
}

sub DESTROY {
    my $self = shift;
    $self = {};
}

sub _read {
    my $self = shift;
    my $data = $self->read_until_dot or
      return undef;
    return $data;
}

sub _query {
    my $self = shift;
    my $data = $self->message();
	my $code = $self->code();
	my @returns;
	if ($code == 210 || $code == 211) {


		my $data = $self->read_until_dot
			or return undef;
		foreach my $i (@{$data}) {
			next if $i =~ /^\.$/;
			$i =~
				/([^\s]+)\s([^\s]+)\s([^\/|\:|\-]+)\s[\/|\|:|\-]\s?(.*)\s?/;
			push @returns, {GENRE =>$1,DISCID =>$2,ARTIST=>$3,ALBUM=>$4};
		}
	} else {
		#we got a single; parse it, hash it and return it
    	$data =~ /([^\s]+)\s([^\s]+)\s([^\/|\:|\-]+)\s[\/|\:|\-]\s?(.*)\s?/;
		push @returns, {GENRE=>$1,DISCID=>$2,ARTIST=>$3,ALBUM=>$4};
	}
	return @returns;
}

sub _sites {
    my $self = shift;
    my $data = $self->read_until_dot
		or return undef;
    my @sites;
    foreach (@$data) {
	s/([^\s]+)\s([^\s]+).*/$1 $2/;
	push(@sites, $_);
    }
    return \@sites;
}

sub _READ      { shift->command('CDDB READ',@_)->response == CMD_OK }
sub _SITES     { shift->command('SITES',@_)->response == CMD_OK }
sub _LSCAT     { shift->command('CDDB LSCAT')->response == CMD_OK }
sub _QUERY     { shift->command('CDDB QUERY',@_)->response == CMD_OK }
sub _QUIT      { shift->command('QUIT')->response == CMD_OK }

sub _WRITE     { shift->command('CDDB WRITE',@_)->response == CMD_OK }
sub _WHOM      { shift->command('CDDB WHOM')->response == CMD_OK }
sub _UPDATE    { shift->command('CDDB UPDATE')->response == CMD_OK }
sub _VER       { shift->command('CDDB VER')->response == CMD_OK }
sub _STAT      { shift->command('CDDB STAT')->response == CMD_OK }
sub _PROTO     { shift->command('CDDB PROTO')->response == CMD_OK }
sub _MOTD      { shift->command('CDDB MOTD')->response == CMD_OK }
sub _LOG       { shift->command('CDDB LOG',@_)->response == CMD_OK }
sub _HELP      { shift->command('CDDB HELP')->response == CMD_OK }
sub _DISCID    { shift->command('DISCID',@_)->response == CMD_OK }


1;
__END__