File Coverage

blib/lib/Net/CDDBScan.pm

Criterion	Covered	Total	%
statement	79	140	56.4
branch	21	76	27.6
condition	6	45	13.3
subroutine	13	16	81.2
pod	0	8	0.0
total	119	285	41.7

package Net::CDDBScan;
require 5.004;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use LWP::Simple;
#use HTTP::Status;
use URI::Escape;
#use Data::Dumper;

require Exporter;

@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.
@EXPORT = qw//;

@EXPORT_OK = qw/new getsongs getablums getartist/;

$VERSION = '2.01';

# constructor optional params are: DEBUG and CONT
# {{{ new

sub new {
    my $class = shift;
    my $self = {};
    bless($self, $class);
    $self->{ARG} = {@_};
    $self ? return $self : return undef;
}

# }}} new

# wrapper func to get songs from the given url
# {{{ getsongs

sub getsongs {
    my $self = shift;
    if (@_) {
	$self->{URL} = uri_escape(shift);
	$self->{ERROR} = undef;
	$self->{TYPE} = 'track';
	print "$self>>Calling _getsongs();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} == 2);
	$self = _getsongs($self);
	defined $self->{ERROR} ? return undef : return $self->{SONGS};
    }
    $self->{ERROR} = 'No url provided';
    return undef;
}

# }}} getsongs

# wrapper func to get albums from the given url
# {{{ getalbums

sub getalbums {
    my $self = shift;
    if (@_) {
	$self->{URL} = uri_escape(shift);
	$self->{ERROR} = undef;
	$self->{TYPE} = 'disc';
	print "$self>>Calling _getalbums();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} == 2);
	$self = _getalbums($self);
	defined $self->{ERROR} ? return undef : return $self->{ALBUMS};
    }
    $self->{ERROR} = 'No url provided';
    return undef;
}

# }}} getalbums

# wrapper func to get artist name(s) from the given url
# {{{ getartist

sub getartist {
    my $self = shift;
    if (@_) {
	$self->{URL} = uri_escape(shift);
	$self->{ERROR} = undef;
	$self->{TYPE} = 'artist';
	print STDOUT "$self>>Calling _getartist();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} == 2);
	$self = _getartist($self);
	defined $self->{ERROR} ? return undef : return $self->{ARTIST};
    }
    $self->{ERROR} = 'No url provided';
    return undef;
}

# }}} getartist

# destructor
# {{{ DESTROY

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

# }}} DESTROY

# get html data based on the given url
# {{{ GetURL

sub GetURL {
    my $self = shift;
    if ($self->{URL} =~ /(www|\/|htm)/) {
	$self->{URL} =~ s!(.*cddb.com/|.*xm/)(.*)!$2!;
	$self->{URL} =~ s!^/?(.*)!$1!;
	$self->{URL} = 'http://www.cddb.com/xm/' . $self->{URL};
    } else {
	$self->{URL} = 'http://www.cddb.com/xm/search?q=' . $self->{URL};
#	$self->{URL} .= '&f=' . $self->{TYPE} if (($self->{TYPE} eq 'track') || ($self->{TYPE} eq 'artist'));
	$self->{URL} .= '&f=' . $self->{TYPE} if ($self->{TYPE} eq 'track');
    }

    print STDOUT "$self>>URL: $self->{URL}\n" if $self->{ARG}->{DEBUG};
    my $data = get($self->{URL});

    #    if (is_error($data)) {
    #	$self->{ERROR} = status_message($data);
    #	return undef;
    #    }
    $self->{DATA} = [split('\n', $data)];
    return $self
}

# }}} GetURL

# locates and returns a hash of url/names based on the given url
# {{{ _getalbums

sub _getalbums {
    my $self = shift;
    # setup some local vars
    my($line, $n1, $n2, $n3, $n4);

    print "$self>>Calling GetURL();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
    $self = GetURL($self);

    return $self if (!$self->{DATA});

    foreach $line (@{$self->{DATA}}) {
	if ($line =~ /^\s*?]/) {

	    if ($line =~ m!\s?(([^<]+)\s?\/\s?)?([^<]+).*!) {
		($n1, $n2, $n3, $n4) = ($1, $2, $3, $4);
		push(@{$self->{OLDURL}}, $self->{URL});
		print "$self>> Got an album: '$n4'\n" if $self->{ARG}->{DEBUG};
		$self->{URL} = $n1;
		$self->{ALBUMS}->{$n1} = $n4;
	    }
	}

	if ($self->{ARG}->{CONT}) {

	    if ($line =~ m!.*\[.+NEXT.*\]!) {
		push(@{$self->{OLDURL}}, $self->{URL});
		$self->{URL} = $1;
		print "$self>>Calling _getalbums();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
		_getalbums($self);
	    }
	}
    }
    return $self;
}

# }}} _getalbums

# locates and returns an hash of url/names based on the given url
# {{{ _getsongs

sub _getsongs {
    my $self = shift;
    my($line, $n1, $n2, $n3, $n4);

    print "$self>>Calling GetURL();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
    $self = GetURL($self);

    return $self if (!$self->{DATA});

    foreach $line (@{$self->{DATA}}) {
	if ($line =~ /^\s*?]/) {

	    if ($line =~ m!\s?(([^<]+)\s?\/\s?)?([^<]+).*!) {
		($n1, $n2, $n3, $n4) = ($1, $2, $3, $4);

		if ((defined $n2 && $n2 !~ /^(\s+)?$/) && (defined $n3 && $n3 !~ /^(\s+)?$/) && ($1 !~ /track/)) {
		    push(@{$self->{OLDURL}}, $self->{URL});
		    $self->{URL} = $n1;
		    print "$self>>Calling _getsongs();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
		    _getsongs($self);
		    last unless $self->{ARG}->{CONT};
		} else {
		    push(@{$self->{OLDURL}}, $self->{URL});
		    print "$self>> Got a song: $n4\n" if $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} == 2;
		    $self->{URL} = $n1;
		    $self->{SONGS}->{$n1} = uri_unescape($n4);
		}
	    }
	}
    }
    if ($self->{ARG}->{CONT}) {
	foreach $line (@{$self->{DATA}}) {
	    if ($line =~ m!.*\[.+NEXT.*\]!) {
		push(@{$self->{OLDURL}}, $self->{URL});
		$self->{URL} = $1;
		print "$self>>Calling _getsongs();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
		_getsongs($self);
	    }
	}
    }
    $self->{DATA} = undef;
    return $self;
}

# }}} _getsongs

# locates and returns an artist based on the given url
# {{{ _getartist

sub _getartist {
    my $self = shift;
    my($line, $n1, $n2, $n3, $n4);

    print "$self>>Calling GetURL();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
    $self = GetURL($self);

    return $self if (!$self->{DATA});

    foreach $line (@{$self->{DATA}}) {
	if ($line =~ /^\s*?]/) {

	    if ($line =~ m!\s?(([^\/]+)\/)?\s?([^<]+)!) {
		($n1, $n2, $n3, $n4) = ($1, $2, $3, $4);
		if ($n3 !~ /^(\s+)?$/) {
		    $self->{ARTIST} = $n3;
		    last;
		}
		push(@{$self->{OLDURL}}, $self->{URL});
		$self->{URL} = $n1;
		print "$self>>Calling _getmessage();\n" if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} ==2);
		_getartist($self);
	    }
	}
    }
    $self->{DATA} = undef;
    return $self;
}

# }}} _getartist

# loads the master db hash from disk
sub load_data {
}

# writes the master db hash to disk
sub dump_data {
}

# takes a hashref off the master db hash and links it on the $self obj for current return data
sub link_data {
    my $self = shift;
}
1;
__END__