File Coverage

blib/lib/WWW/Bleep.pm

Criterion	Covered	Total	%
statement	71	144	49.3
branch	12	46	26.0
condition	7	46	15.2
subroutine	12	12	100.0
pod	5	5	100.0
total	107	253	42.2

package WWW::Bleep;

use 5.008;
use strict;
use warnings;
use LWP::UserAgent;
use HTML::TokeParser;

require Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );

@EXPORT = qw(error album artists tracks);
@EXPORT_OK = qw();
@ISA = qw(Exporter);
$VERSION = '0.92';

sub new($);
sub album($);
sub artists($$);
sub tracks($$);
sub error($);
sub _cleanurldata($);

=head1 NAME

WWW::Bleep - Perl interface to Bleep.com

=head1 VERSION

Version 0.92

=head1 SYNOPSIS

use WWW::Bleep;

my $bleep = WWW::Bleep->new();

my @tracks = WWW::Bleep->tracks( artist => 'Aphex Twin' );

=head1 DESCRIPTION


A Perl interface to Bleep.com.  Specfically for searching artist,
album, and label data.  Current purpose is the help with cataloging
your personal (physical) album collection.

This has no shopping cart capability and it isn't planned.
(Less there is some dire need for it.)


=head1 FUNCTIONS

=head2 new

    Create a new WWW::Bleep object.

    Currently has no arguments.

=cut

sub new($) {
	my $class = shift;
	my $self = bless {
		_base_url => 'http://www.bleep.com/',
		_ua => LWP::UserAgent->new(),
		_parser => '',
		_response => '',
		_error => '',
	}, $class;
	$self->{'_ua'}->agent('');#"WWW::Bleep v$VERSION");
	return $self;
}


=head2 error

    Returns an error description or ''.

    Doesn't take or require any arguments.

    For the sake of your own sanity, check this ne '' after every call.
    The most you'd generally get from other routines as far as errors are
    concerned would be a null response.

=cut

sub error($) {
	my $self = shift;
	return $self->{_error};
}


=head2 album

    Gathers album data based on the arguments given.

    Requires one of the following arguments:

        cat
        (eventually title)

    Returns a hash containing relevant album and track data.
    Specifically artist, date, label, title, and tracks. artist,
    date, label, and title are all scalars.  date may always be
    returned.

   tracks contains the following array

        track_number => {
            'time'  => length_in_standard_time,
            'title' => track_title,
            'valid' => 1_=_downloadable__0_=_not
        }
        next_track_number => {
            'time'  => length_in_standard_time,
            'title' => track_title,
            'valid' => 1_=_downloadable__0_=_not
        }
        ...

=cut

sub album($) {
	my $self = shift;
	my %args = @_;

	my $album_url = $self->{'_base_url'}.'current_item.php';
	my $title;
	my $number;
	my %album;
	my $slimcat;
	my $token;

	if ( length($args{'cat'}) > 3 ) {
		$args{'cat'} = uc($args{'cat'});
		if ( $args{'cat'} !~ /_DM$/ ) {
			$args{'cat'} .= '_DM';
		}
		$slimcat = substr($args{'cat'},0,length($args{'cat'})-3);
		$album_url .= ('?selection='.$args{'cat'});
		$self->{_response} = $self->{_ua}->get( $album_url );
		if ( $self->{_response}->is_success ){
			$self->{_parser} = HTML::TokeParser->new(
				\$self->{_response}->content
			);
			while ( $token = $self->{_parser}->get_tag('div') ){
				if ($token->[1]{class} &&
						$token->[1]{class} eq 'bleep2selectionTitle') {
					while ( $token = $self->{_parser}->get_token() ){

						# Set album artist
						if ( !$album{artist} && $token->[3][0] &&
								$token->[3][0] eq 'href' ) {
							if ( $token->[2]{href} =~ /^search\.php/ ){
								$token = $self->{_parser}->get_token();
								$album{artist} = $token->[1];
							}
						}

						# Set album title and date if applicable
						if ( !$album{title} &&
								$token->[1] =~ /^(.+) \($slimcat\)$/ ){
							$album{title} = $1;
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$token = $self->{_parser}->get_token();
							$album{label} = $token->[1];
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$token = $self->{_parser}->get_token();
							if ( $token->[0] eq 'T' &&
									$token->[1] =~ /(\d{1,2}) \/ (\d{1,4})/ ){
								$album{date} = "$1/$2";
							}
						}

						if ( $token->[0] eq 'S' && $token->[1] eq 'td'&&
								$token->[2]{width} &&
								$token->[2]{width} eq '24' ){

							$token = $self->{_parser}->get_token();
							$token->[1] =~ /(\d\d)/;
							$number = $1;

							#  There's got to be a better way to skip
							#  ahead tokens!
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$self->{_parser}->get_token();
							$token = $self->{_parser}->get_token();

							$token->[1] =~ /(.+) \((\d{1,2}:\d\d)\)/;
							if ( $2 ){
								$album{tracks}->{$number}{title} = $1;
								$album{tracks}->{$number}{time} = $2;

								# Is the track buyable?
								$album{tracks}->{$number}{valid} = 1;
							}
							else{
								$album{tracks}->{$number}{valid} = 0;
							}
						}
					}
				}
			}
			return %album;
		}

		# Page could not be loaded!
		else {
			$self->{_error} = $self->{_response}->status_line;
			return 0;
		}
	}
	else {
		$self->{_error} = qq(Please use a catalog value with four or more characters.);
		return 0;
	}
}


=head2 artists

    Returns an array of artists from Bleep.com.  An optional argument
    must be a valid record label name.

        # Returns all artists (Be careful with this one,
        #                      the list is very large!)
        @artists = $bleep->artists();

        # Returns only artists on Warp
        @artists = $bleep->artists( 'Warp' );

        # Returns null (not a valid record label)
        @artists = $bleep->artists( 'foo1234' );

    Due to the size of the artist list, it may take a minute to
    populate.

=cut

sub artists($$) {
	my $self = shift;
	my %args = @_;
	undef $self->{artists};

	my $artists_url = $self->{'_base_url'}.'browse_artists.php?label=';
	$artists_url .= _cleanurldata( uc($args{'label'}) );

	$self->{_response} = $self->{_ua}->get( $artists_url );

	if ( $self->{_response}->is_success ){
		$self->{_parser} = HTML::TokeParser->new(\$self->{_response}->content);

		while( my $token = $self->{_parser}->get_tag("a") ){
			my $url = $token->[1]{href} || '-';
			my $text = $self->{_parser}->get_trimmed_text("/a");
			unless ( $url eq 'javascript:void(0);' ){
				push @{$self->{_artists}}, $text;
			}
		}
		if( $self->{_artists} ){
			return @{$self->{_artists}};
		}
		else {
			 $self->{error} = qq(No artists could be found!);
		}
	}
	else {
		$self->{error} = qq(No response from url!\nDo you have an active internet connection and is bleep.com up?);
		return 0;
	}
}


=head2 tracks

    Gathers the tracks based on the arguments given.

    Requires one or of the following arguments:

        artist
        label
        album*

    Returns an array of hashes of track names, track numbers and album
    catalog numbers.  *Currently, 'album' dies off, as it uses a
    different method that hasn't been configured.

=cut

sub tracks($$) {
	my $self = shift;
	my %args = @_;
	my $tracks_url = $self->{'_base_url'}.'browse_results.php?';

	undef $self->{_tracks};
	undef $self->{hastracks};

	if ($args{artist} || $args{label} || $args{album}) {
		if ($args{artist}) {
			$tracks_url .= ('artist='._cleanurldata($args{artist}).'&');
		}
		if ($args{label}){
			$tracks_url .= ('label='._cleanurldata($args{label}).'&');
		}
		if ($args{album}) {
			die "Option \"album\" not yet supported!";
		}

		$self->{_response} = $self->{_ua}->get( $tracks_url );

		if ($self->{_response}->is_success) {

			$self->{_parser} = HTML::TokeParser->new(\$self->{_response}->content);

			#  Move the offset so it does not include albums
			while (my $token = $self->{_parser}->get_tag('td')) {
				if ($self->{_parser}->get_trimmed_text('/td') eq 'TRACKS') {
					while (my $token = $self->{_parser}->get_tag("a")) {
						my $url = $token->[1]{href} || '-';
						my $text = $self->{_parser}->get_trimmed_text("/a");
						unless ( !$url || $url eq 'javascript:void(0);' ){
							$url =~ /\?id=(\w+)-(\d\d)/;
							push @{$self->{_tracks}}, {title=>$text,cat=>$1,number=>$2};
						}
					}
					if ($self->{_tracks}) {
						return @{$self->{_tracks}};
					}
					else {
						$self->{error} = qq(Artist exists, but no tracks can be found... Sorry!);
						return 0;
					}
				}
			}
		}
		else {
			$self->{error} = qq(No response from url!  Do you have an active internet connection and is bleep.com up?);
			return 0;
		}
	}
	else {
		$self->{error} = qq(This function requires one or more arguments!);
		return 0;
	}
	1;
}



# Internal routine to fix any obscure characters
sub _cleanurldata($) {
	if ($_[0]) {
		my @data = split //, shift;
		my $val;

		foreach my $char (@data) {
			$val = ord($char);
			if ($val < 48 || ($val > 57 && $val < 65) || $val > 90) {
				$val = unpack('H*',chr($val));
				$char = ('%'.$val);
			}
		}

		$val = join '', @data;
		return $val;
	}
	else {
		return $_[0];
	}
}

=head1 SEE ALSO

L

=head1 AUTHOR

Clif Bratcher, [e-mail]

=head1 COPYRIGHT AND LICENSE


Copyright (C) 2006 - 2009 by Clif Bratcher

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut