package WebService::FreeDB; use Data::Dumper; use LWP::UserAgent; # Erweiterung jb require Exporter; @ISA = qw(Exporter); @EXPORT = qw//; @EXPORT_OK = qw/getdiscs getdiscinfo ask4discurls outdumper outstd/; $VERSION = '0.77'; ##### # Description: for getting a instace of this Class # Params: %hash with keys: # HOST : Destination host, if not defined: www.freedb.org # PATH : Path on HOST to CGI # PROXY: Define Proxy to use # DEFAULTVALUES : Default parameters for CGI, will be set always # Returns: an object of this class ##### sub new { my $class = shift; my $self = {}; $self->{ARG} = {@_}; if(!defined($self->{ARG}->{HOST})) { #Maybe there are other freedb-web-interfaces ?! $self->{ARG}->{HOST}='http://www.freedb.org' } if(!defined($self->{ARG}->{PATH})) { #Path to CGI-script $self->{ARG}->{PATH}='/freedb_search.php'} if(!defined($self->{ARG}->{PROXY})) { #If there's no proxy, define but don't change it $self->{ARG}->{PROXY}='' } if(!defined($self->{ARG}->{DEFAULTVALUES})) { #default Parameters $self->{ARG}->{DEFAULTVALUES}='&allfields=NO&grouping=none' } bless($self, $class); $self ? return $self : return undef; } ##### # Description: out of Keywords it will return a List of entries in FreeDB # Params: ,[Array of fields to search in], # [Array of categories to search in] # Returns: %Hash, where urls are Key and [Array of Artist,Album] is value% ##### sub getdiscs { my $self = shift; my @keywords = split(/ /,shift); my @fields = @{$_[0]}; if(defined $_[1]) {@cats = @{$_[1]};} my %discs; my $url = $self->{ARG}->{HOST}. $self->{ARG}->{PATH}."?". $self->{ARG}->{DEFAULTVALUES}; $url .="&words=".shift(@keywords); for my $word (@keywords) { $url .= "+".$word; } for my $field (@fields) { if(!($field =~ /^(artist|title|track|rest)$/)) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*unknown field-type: $field;\n" } next; } $url .= "&fields=".$field; } if (defined(@cats)) { $url .= "&allcats=NO"; for my $cat (@cats) { if(!($cat =~ /^(blues|classical|country|data|folk|jazz|misc|newage|reggae|rock|soundtrack)$/)) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*unknown cat-type: $cat;\n" } next; } $url .= "&cats=".$cat; } } else { $url .= "&allcats=YES"; } if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**url-search: $url;\n" ; } my $ua = LWP::UserAgent->new(); $ua->proxy('http' => $self->{ARG}->{PROXY}); my $req = HTTP::Request->new(GET => $url); my $response = $ua->request($req); if ($response->is_success) { my $data = $response->content; @lines = split /\n/, $data ; my $liststart = 0 ; my $lastref; for my $line (@lines) { #if($line =~ /^

all categories<\/h2>$/) { #update at 31.3.06: changed this if($line =~ /^

freedb music CD search results<\/h2>$/) { $liststart=1; } elsif ( $liststart == 1 && $line =~ /{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**list start found;\n"; } $liststart=2; } elsif ( $liststart == 2 && $line =~ /
(.+) \/ (.+)<\/a>   \d+<\/font><\/a>/ ) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 3) { print STDERR "***multilist element found $url;\n"; } if(!(defined($discs{$1}))) { $discs{$1} = [$2,$3,$4]; $lastref = $1; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*already got an disc, taking old one !: $line;\n"; } } #} elsif ( $liststart == 2 && $line =~ /^
(.+) \/ (.+)<\/a>
/ ) { } elsif ( $liststart == 2 && $line =~ /
.*(.+) \/ (.+)<\/a>/ ) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 3) { print STDERR "***list element found $url;\n"; } if(!(defined($discs{$1}))) { $discs{$1} = [$2,$3]; $lastref = undef; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*already got an disc, taking old one !: $line;\n"; } } } elsif (defined($lastref) && $liststart == 2 && $line =~ /^\d+<\/font><\/a>/ ) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 3) { print STDERR "***more multilist element found $url;\n" ; } if(!(defined($discs{$lastref}))) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*but no lastref-element found $url;\n"; } } else { push(@{$discs{$lastref}},$1); } } elsif ( $liststart == 2 && $line =~ /^<\/table>$/) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**list end found;\n"; } $liststart = 0; } elsif ($liststart == 2 ) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 3) { print STDERR "***unknown line-type, ignoring : $line;\n"; } } } } else { die $response->status_line; } return %discs; } ##### # Description: out of a URL (you got as key from getdiscs() ) will retrieve # concrete Informations of this CD. # Params: # Returns: %Hash of items of the CD% ##### sub getdiscinfo { my $self = shift; my $url = shift; my %disc; if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**url-disc:$url;\n"; } my $ua = LWP::UserAgent->new(); $ua->proxy('http' => $self->{ARG}->{PROXY}); my $req = HTTP::Request->new(GET => $url); my $response = $ua->request($req); if ($response->is_success) { my $data = $response->content; if (!defined($data)) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*found no disc;\n"; } return ; } $disc{url} = $url; @lines = split(/\n/,$data); $line = shift(@lines); #ignore until begin of data while (!($line =~ /^
$/)) { $line = shift(@lines); } if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**found start of data :$line;\n"; } if ($lines[0] =~ /^

(.+) \/ (.+)<\/h2>$/) { $disc{artist} = $1; $disc{album} = $2; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*format error(artist+album):$lines[0];\n"; } } #ignore commercials while (!($lines[1] =~ /^\s*tracks:\s*?(\d+)
$/)) { shift(@lines); } if ($lines[1] =~ /^\s*tracks:\s*?(\d+)
$/) { $disc{tracks} = $1; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*format error(tracks):$lines[1];\n"; } } if ($lines[2] =~ /^total time:\s*(\d+:\d+)
$/) { $disc{totaltime} = $1; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*format error(totaltime):$lines[2];\n"; } } if ($lines[3] =~ /^year:\s*(\d*)
$/) { $disc{year} = $1; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*format error(year):$lines[3];\n"; } } if ($lines[4] =~ /^genre:\s*(.*)
$/) { $disc{genre} = $1; } else { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*format error(genre):$lines[4];\n"; } } if(!defined($disc{artist})) {$disc{artist} = "";} if(!defined($disc{album})) {$disc{album} = "";} if(!defined($disc{year})) {$disc{year} = "";} if(!defined($disc{genre})) {$disc{genre} = "";} while (!($line =~ /^$/)) { #ignore until begin of tackinfo if ($line =~ /^

$/) {
				$line = shift(@lines);
				while (!($line =~ /<\/pre><\/tr><\/td><\/table><\/center>/)) {
					$disc{rest} .= $line."\n";
					$line = shift(@lines);
				}
			}
			$line = shift(@lines);
			if (!defined($line)) {
				$disc{trackinfo} = defined;
				return %disc;  #break if not found beginning (empty entries)
			}
		}
		if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) {
			print STDERR "**found start of trackinfo:$line;\n";
		}
		$index = 1;
		for my $line (@lines) {
			if ($line =~ /^

<\/td><\/tr>$/) {next;} elsif ($line =~ /^.*?<\/font>/) {next;} # ignore ext-desc of a track elsif ($line =~ /^
{0,1}$index\.<\/td> {0,1}(\d+:\d+)<\/td>(.+)<\/b>/) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 3) { print STDERR "***found track: $line;\n"; } $disc{trackinfo}[$index-1]=[$2,$1]; $index++; } elsif ($line =~ /^
\d+\.<\/td> (\d+:\d+)<\/td>(.+)<\/b>/) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*out of sync for trackinfo:$line;\n"; } } elsif ($line =~ /^<\/table>$/) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 2) { print STDERR "**found end of trackinfo & data: $line;\n"; } } else {next;} } return %disc; } else { #print STDERR "Url was: ".$url."\n"; die $response->status_line; } } ##### # Description: User interactive method (console) for selecting CDs for retrieval # Params: %Hash, where urls are Key and [Array of Artist,Album] is value% # (you got it from getdiscs()) # Returns: [Array of URLs, which where selected by User] ##### sub ask4discurls { my $self = shift; my %discs = %{$_[0]}; #sort for artists my @keys = sort { $discs{$a}[0] cmp $discs{$b}[0] || $discs{$a}[1] cmp $discs{$b}[1]} keys %discs; my @urls; if(!defined($keys[0])) { print STDERR "Sorry - no matching discs found\n"; return 1; } #giving list 2 user for (my $i=0;$i<@keys;$i++) { print STDERR "$i) ".$discs{$keys[$i]}[0]." / ".$discs{$keys[$i]}[1]; if (defined $discs{$keys[$i]}[2]) { print STDERR " [".(@{$discs{$keys[$i]}} - 2)." alternatives]"; } print STDERR "\n"; } print STDERR "Select discs (space seperated numbers or -;alternatives by appending 'A' and alternate-number):\n"; $userin = ; chomp $userin; while($userin =~ /(\d+)A(\d+)-(\d+)A(\d+)/) { # 23A2-42A3 - so with beginning alternatives if(!($1<$3)) { print STDERR "Ignoring $1-$3 ..."; } my $tmpadd = $1."A".$2." "; for(my $i=$1+1;$i<=$3-1;$i++) { $tmpadd .= $i." "; } $tmpadd .= $3."A".$4; $userin =~ s/$1A$2-$3A$4/$tmpadd/; } while($userin =~ /(\d+)A(\d+)-(\d+)/) { # 23A2-42 - so with beginning alternatives if(!($1<$3)) { print STDERR "Ignoring $1-$3 ..."; } my $tmpadd = $1."A".$2." "; for(my $i=$1+1;$i<=$3;$i++) { $tmpadd .= $i." "; } $userin =~ s/$1A$2-$3/$tmpadd/; } while($userin =~ /(\d+)-(\d+)A(\d+)/) { # 23-42A2 - so with beginning alternatives if(!($1<$2)) { print STDERR "Ignoring $1-$2 ..."; } my $tmpadd = ""; for(my $i=$1;$i<=$2-1;$i++) { $tmpadd .= $i." "; } $tmpadd .= $2."A".$3; $userin =~ s/$1-$2A$3/$tmpadd/; } while($userin =~ /(\d+)-(\d+)/) { # 23-42 - so without alternatives if(!($1<$2)) { print STDERR "Ignoring $1-$2 ..."; } my $tmpadd = ""; for(my $i=$1;$i<=$2;$i++) { $tmpadd .= $i." "; } $userin =~ s/$1-$2/$tmpadd/; } @select = split (/ /,$userin); for my $cd (@select) { if ($cd =~ /^\d+$/ && defined($keys[$cd])) { push(@urls,$keys[$cd]); } elsif ($cd =~ /^(\d+)A(\d+)$/ && $discs{$keys[$1]}[($2+2)]) { push(@urls,$discs{$keys[$1]}[($2+2)]); } else { print STDERR "not defined '$cd' - ignoring!\n"; } } return @urls; } ##### # Description: output-method of the retrieved CD # this goes out to STDOUT by using Data:Dumper # Params: %Hash of items of the CD% # (you got it from getdiscinfo()) # Returns: nothing ##### sub outdumper { if(!defined($disc{url})) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*no disc info \n"; } return 1; } my $self = shift; my $disc = shift; print Dumper $disc; } ##### # Description: output-method of the retrieved CD # this goes out to STDOUT in a pretty formated Look # Params: %Hash of items of the CD% # (you got it from getdiscinfo()) # Returns: nothing ##### sub outstd { my $self = shift; my %disc = %{$_[0]}; if(!defined($disc{url})) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*no disc info \n"; } return 1; } print "DiscInfo:\n########\n"; print "Artist:".$disc{artist}." - Album: ".$disc{album}."\n"; print "Reference:".$disc{url}."\n"; print "Total-Tracks:".$disc{tracks}." - Total-Time:".$disc{totaltime}."\n"; print "Year:".$disc{year}." - Genre:".$disc{genre}."\n"; if(defined($disc{rest})) {print "Comment:".$disc{rest}."\n";} print "Tracks:\n"; for (my $i=0;$i<@{$disc{trackinfo}};$i++) { print 1+$i.") ".${$disc{trackinfo}}[$i][0]." (".${$disc{trackinfo}}[$i][1].")\n"; } } ##### # Description: output-method of the retrieved CD # this goes out to STDOUT in XML # validating against example/cdcollection.dtd # Params: %Hash of items of the CD% # (you got it from getdiscinfo()) # Returns: nothing ##### sub outxml { my $self = shift; my %disc = %{$_[0]}; if(!defined($disc{url})) { if (defined $self->{ARG}->{DEBUG} && $self->{ARG}->{DEBUG} >= 1) { print STDERR "*no disc info \n" ; } return 1; } print "\n"; if(defined($disc{medium})) {print "\t".ascii2xml($disc{medium})."\n";} if(defined($disc{id})) {print "\t".ascii2xml($disc{id})."\n";} if (defined($disc{artist})) {print "\t".ascii2xml($disc{artist})."\n";} print "\t".ascii2xml($disc{album})."\n"; if (defined($disc{year})) {print "\t".ascii2xml($disc{year})."\n";} if(defined($disc{source})) {print "\t".ascii2xml($disc{source})."\n";} if(defined($disc{quality})) {print "\t".ascii2xml($disc{quality})."\n";} if(defined($disc{comment})) {print "\t".ascii2xml($disc{comment})."\n";} print "\t\n"; for (my $i=0;$i<@{$disc{trackinfo}};$i++) { my ($artist1,$name1) = split(/ \/ /,${$disc{trackinfo}}[$i][0]); my ($artist2,$name2) = split(/ - /,${$disc{trackinfo}}[$i][0]); if (defined($disc{type}) && $disc{type} eq "sampler" && defined $name1) { print "\t\t\n"; if(defined($artist1)) {print "\t\t\t".ascii2xml($artist1)."\n";} if(defined($name1)) {print "\t\t\t".ascii2xml($name1)."\n";} if(defined($disc{trackinfo}[$i][1])) {print "\t\t\t\n";} if(defined($disc{trackinfo}[$i][2])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][2])."\n";} print "\t\t\n"; print STDERR "Splitted title ' / ' - highly recommed to check this !\n"; } elsif (defined($disc{type}) && $disc{type} eq "sampler" && defined $name2) { print "\t\t\n"; if(defined($artist2)) {print "\t\t\t".ascii2xml($artist2)."\n";} if(defined($name2)) {print "\t\t\t".ascii2xml($name2)."\n";} if(defined($disc{trackinfo}[$i][1])) {print "\t\t\t\n";} if(defined($disc{trackinfo}[$i][2])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][2])."\n";} print "\t\t\n"; print STDERR "Splitted title ' - ' - highly recommed to check this !\n"; } elsif (defined($disc{type}) && $disc{type} eq "sampler") { print "\t\t\n"; if(defined($disc{trackinfo}[$i][0])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][0])."\n";} if(defined($disc{trackinfo}[$i][1])) {print "\t\t\t\n";} if(defined($disc{trackinfo}[$i][2])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][2])."\n";} print "\t\t\n"; print STDERR "NOT Splitted title - highly recommed to check this !\n"; } else { print "\t\t\n"; if(defined($disc{trackinfo}[$i][0])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][0])."\n";} if(defined($disc{trackinfo}[$i][1])) {print "\t\t\t\n";} if(defined($disc{trackinfo}[$i][2])) {print "\t\t\t".ascii2xml(${$disc{trackinfo}}[$i][2])."\n";} print "\t\t\n"; } } print "\t\n"; print "\n"; } ##### # Description: PRIVATE - not for use outside ! # Converts special XML Chars to XML-style # Params: # Returns: ##### sub ascii2xml { $ascii = $_[0]; $ascii =~ s/&/&/g; $ascii =~ s//>/g; $ascii =~ s/'/'/g; $ascii =~ s/"/"/g; return $ascii; } return 1; __END__ =head1 NAME WebService::FreeDB - retrieving entries from FreeDB by searching for keywords (artist,track,album,rest) =head1 SYNOPSIS use WebService::FreeDB; Create an Object $freedb = WebService::FreeDB->new(); Get a list of all discs matching 'Fury in the Slaughterhouse' %discs = $cddb->getdiscs( "Fury in the Slaughterhouse", ['artist','rest'] ); Asks user to select one or more of the found discs @selecteddiscs = $cddb->ask4discurls(\%discs); Get information of a disc %discinfo = $cddb->getdiscinfo(@selecteddiscs[0]); print disc-information to STDOUT - pretty nice formatted $cddb->outstd(\%discinfo); =head1 DESCRIPTION WebService::FreeDB uses a FreeDB web interface (default is www.freedb.org) for searching of CD Information. Using the webinterface, WebService::FreeDB searches for artist, song, album name or the ''rest'' field. The high level functions included in this modules makes it easy to search for an artist of a song, all songs of an artist, all CDs of an artist or whatever. =head1 USING WebService::FreeDB =head2 How to work with WebService::FreeDB =over 5 =item B This has to be the first step my $cddb = WebService::FreeDB->new() You can configure the behaviour of the Module giving new() optional parameters: Usage is really simple. To set the debug level to 1, simply: my $cddb = WebService::FreeDB->new( DEBUG => 1 ) B B: [0 to 3] - Debugging information, C<0> is default (means no additional information), 3 gives a lot of stuff (hopefully) nobody needs. All debug information goes to STDERR. B: FreeDB-Host where to connect to. C is default - has to have a webinterface - no normal FreeDB-Server ! B: Path to the php-script (the webinterface) C is default - so working on www.freedb.org B: proxy to use for connecting to FreeDB-Server C is default B: Values with will be set for every request. C is default, so the grouping feature is not supported until now. =item B Now we retrieve a list of CDs, which match to your keywords in given fields. Available fields are C. Available categories are C For explanation see the webinterface. %discs = $cddb->getdiscs( "Fury in the Slaughterhouse", [qw( artist rest )] ); The returned hash includes as key the urls for retriving the concrete data and as value a array of the artist,the album name followed by the alternative disc-urls =item B After retrieving a huge list of possible matches we have to ask the user to select one or more CDs for retrieval of the disc-data. @selecteddiscs = $cddb-Eask4discurls(\%discs); The function returns an array of urls after asking user. (using STDERR) The user can select the discs by typing numbers and ranges (e.g. 23-42) =item B This functions gets a url and returns a hash including all disc information. %discinfo = $cddb-Egetdiscinfo(@selecteddiscs[0]); So we have to call this function n-times if the user selects n cds. The hash includes the following keys C These are all string except trackinfo, this is a array of arrays. Every of these small arrays represent a track: first its name , second its time. Please keep an eye on track vs. length of the trackinfo array. Some entries in FreeDB store an other number of tracks than they have stored ! =item B Now the last step is to print the information to the user. $cddb->outdumper(\%discinfo); # Like Data::Dumper $cddb->outstd(\%discinfo); # nicely formatted to stdout $cddb->outxml(\%discinfo); # XML format These 3 functions print a retrieved disc out. The XML format outputs according to example/cdcollection.dtd this method does not use every information. This Function also prints some additional information out, if given. This is, because it is used by other projects, such like music-moth (www.moth.de) I think this is the point for starting your work: Take %discinfo and write whhat ever you want. =back =head1 NOTICE Be aware this module is in B stage. =head1 AUTHOR Copyright 2002-2003, Henning Mersch All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Address bug reports and comments to: hm@mystical.de =head1 BUGS None known - but feel free to mail if you got some ! =head1 SEE ALSO perl(1) www.freedb.org =cut