File Coverage

blib/lib/CDDB_get.pm
Criterion Covered Total %
statement 21 300 7.0
branch 0 160 0.0
condition 0 3 0.0
subroutine 7 12 58.3
pod 0 5 0.0
total 28 480 5.8


line stmt bran cond sub pod time code
1             #
2             # CDDB - Read the CDDB entry for an audio CD in your drive
3             #
4             # This module/script gets the CDDB info for an audio cd. You need
5             # LINUX, a cdrom drive and an active internet connection in order
6             # to do that.
7             #
8             # (c) 2004 Armin Obersteiner
9             #
10             # LICENSE
11             #
12             # This library is released under the same conditions as Perl, that
13             # is, either of the following:
14             #
15             # a) the GNU General Public License Version 2 as published by the
16             # Free Software Foundation,
17             #
18             # b) the Artistic License.
19             #
20              
21             package CDDB_get;
22              
23 1     1   27500 use Config;
  1         2  
  1         39  
24              
25 1     1   6 use strict;
  1         4  
  1         41  
26 1     1   4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $debug);
  1         6  
  1         132  
27              
28             require Exporter;
29              
30             @ISA = qw(Exporter AutoLoader);
31             # Items to export into callers namespace by default. Note: do not export
32             # names by default without a very good reason. Use EXPORT_OK instead.
33             # Do not simply export all your public functions/methods/constants.
34             @EXPORT_OK = qw(
35             get_cddb
36             get_discids
37             );
38             $VERSION = '2.28';
39              
40 1     1   4 use Fcntl;
  1         1  
  1         585  
41 1     1   1232 use IO::Socket;
  1         41169  
  1         140  
42 1     1   5796 use Data::Dumper qw(Dumper);
  1         34619  
  1         268  
43 1     1   3729 use MIME::Base64 qw(encode_base64);
  1         2031  
  1         11634  
44              
45             $debug=1;
46              
47             # setup for linux, solaris x86, solaris spark
48             # you freebsd guys give me input
49              
50             print STDERR "cddb: checking for os ... " if $debug;
51              
52             my $os=`uname -s`;
53             my $machine=`uname -m`;
54             chomp $os;
55             chomp $machine;
56              
57             print STDERR "$os ($machine) " if $debug;
58              
59             # cdrom IOCTL magic (from c headers)
60             # linux x86 is default
61              
62             # /usr/include/linux/cdrom.h
63             my $CDROMREADTOCHDR=0x5305;
64             my $CDROMREADTOCENTRY=0x5306;
65             my $CDROM_MSF=0x02;
66              
67             # default config
68              
69             my $CDDB_HOST = "freedb.freedb.org";
70             my $CDDB_PORT = 8880;
71             my $CDDB_MODE = "cddb";
72             my $CD_DEVICE = "/dev/cdrom";
73              
74             my $HELLO_ID = "root nowhere.com fastrip 0.77";
75             my $PROTO_VERSION = 5;
76              
77             # endian check
78              
79             my $BIG_ENDIAN = unpack("h*", pack("s", 1)) =~ /01/;
80              
81             if($BIG_ENDIAN) {
82             print STDERR "[big endian] " if $debug;
83             } else {
84             print STDERR "[little endian] " if $debug;
85             }
86              
87             # 64bit pointer check
88              
89             my $BITS_64 = $Config{ptrsize} == 8 ? 1 : 0;
90              
91             if($BITS_64) {
92             print STDERR "[64 bit]\n" if $debug;
93             } else {
94             print STDERR "[32 bit]\n" if $debug;
95             }
96              
97             if($os eq "SunOS") {
98             # /usr/include/sys/cdio.h
99              
100             $CDROMREADTOCHDR=0x49b; # 1179
101             $CDROMREADTOCENTRY=0x49c; # 1180
102              
103             if(-e "/vol/dev/aliases/cdrom0") {
104             $CD_DEVICE="/vol/dev/aliases/cdrom0";
105             } else {
106             if($machine =~ /^sun/) {
107             # on sparc and old suns
108             $CD_DEVICE="/dev/rdsk/c0t6d0s0";
109             } else {
110             # on intel
111             $CD_DEVICE="/dev/rdsk/c1t0d0p0";
112             }
113             }
114             } elsif($os =~ /BSD/i) { # works for netbsd, infos for other bsds welcome
115             # /usr/include/sys/cdio.h
116              
117             $CDROMREADTOCHDR=0x40046304;
118             $CDROMREADTOCENTRY=0xc0086305;
119              
120             if($BITS_64) {
121             $CDROMREADTOCENTRY=0xc0106305;
122             }
123              
124             $CD_DEVICE="/dev/cd0a";
125              
126             if($os eq "OpenBSD") {
127             $CD_DEVICE="/dev/cd0c";
128             }
129             }
130              
131             sub read_toc {
132 0     0 0   my $device=shift;
133 0           my $tochdr=chr(0) x 16;
134              
135 0 0         sysopen (CD,$device, O_RDONLY | O_NONBLOCK) or die "cannot open cdrom [$!] [$device]";
136 0 0         ioctl(CD, $CDROMREADTOCHDR, $tochdr) or die "cannot read toc [$!] [$device]";
137 0           my ($start,$end);
138 0 0         if($os =~ /BSD/) {
139 0           ($start,$end)=unpack "CC",(substr $tochdr,2,2);
140             } else {
141 0           ($start,$end)=unpack "CC",$tochdr;
142             }
143 0 0         print STDERR "start track: $start, end track: $end\n" if $debug;
144              
145 0           my @tracks=();
146              
147 0           for (my $i=$start; $i<=$end;$i++) {
148 0           push @tracks,$i;
149             }
150 0           push @tracks,0xAA;
151              
152 0           my @r=();
153 0           my $tocentry;
154 0           my $toc="";
155 0           my $size=0;
156 0           for(@tracks) {
157 0           $toc.=" ";
158 0           $size+=8;
159             }
160            
161 0 0         if($os =~ /BSD/) {
162 0           my $size_hi=int($size / 256);
163 0           my $size_lo=$size & 255;
164              
165 0 0         if($BIG_ENDIAN) {
166 0 0         if($BITS_64) {
167             # better but just perl >= 5.8.0
168             # $tocentry=pack "CCCCx![P]P", $CDROM_MSF,0,$size_hi,$size_lo,$toc;
169 0           $tocentry=pack "CCCCxxxxP", $CDROM_MSF,0,$size_hi,$size_lo,$toc;
170             } else {
171 0           $tocentry=pack "CCCCP8l", $CDROM_MSF,0,$size_hi,$size_lo,$toc;
172             }
173             } else {
174 0 0         if($BITS_64) {
175 0           $tocentry=pack "CCCCxxxxP", $CDROM_MSF,0,$size_lo,$size_hi,$toc;
176             } else {
177 0           $tocentry=pack "CCCCP8l", $CDROM_MSF,0,$size_lo,$size_hi,$toc;
178             }
179             }
180 0 0         ioctl(CD, $CDROMREADTOCENTRY, $tocentry) or die "cannot read track info [$!] [$device]";
181             }
182              
183 0           my $count=0;
184 0           foreach my $i (@tracks) {
185 0           my ($min,$sec,$frame);
186 0 0         unless($os =~ /BSD/) {
187 0           $tocentry=pack "CCC", $i,0,$CDROM_MSF;
188 0           $tocentry.=chr(0) x 16;
189 0 0         ioctl(CD, $CDROMREADTOCENTRY, $tocentry) or die "cannot read track $i info [$!] [$device]";
190 0           ($min,$sec,$frame)=unpack "CCCC", substr($tocentry,4,4);
191             } else {
192 0           ($min,$sec,$frame)=unpack "CCC", substr($toc,$count+5,3);
193             }
194 0           $count+=8;
195              
196 0           my %cdtoc=();
197            
198 0           $cdtoc{min}=$min;
199 0           $cdtoc{sec}=$sec;
200 0           $cdtoc{frame}=$frame;
201 0           $cdtoc{frames}=int($frame+$sec*75+$min*60*75);
202              
203 0           my $data = unpack("C",substr($tocentry,1,1));
204 0           $cdtoc{data} = 0;
205 0 0         if($data & 0x40) {
206 0           $cdtoc{data} = 1;
207             }
208              
209 0           push @r,\%cdtoc;
210             }
211 0           close(CD);
212            
213 0           return @r;
214             }
215              
216             sub cddb_sum {
217 0     0 0   my $n=shift;
218 0           my $ret=0;
219              
220 0           while ($n > 0) {
221 0           $ret += ($n % 10);
222 0           $n = int $n / 10;
223             }
224 0           return $ret;
225             }
226              
227             sub cddb_discid {
228 0     0 0   my $total=shift;
229 0           my $toc=shift;
230              
231 0           my $i=0;
232 0           my $t=0;
233 0           my $n=0;
234            
235 0           while ($i < $total) {
236 0           $n = $n + cddb_sum(($toc->[$i]->{min} * 60) + $toc->[$i]->{sec});
237 0           $i++;
238             }
239 0           $t = (($toc->[$total]->{min} * 60) + $toc->[$total]->{sec}) -
240             (($toc->[0]->{min} * 60) + $toc->[0]->{sec});
241 0           return (($n % 0xff) << 24 | $t << 8 | $total);
242             }
243              
244             sub get_discids {
245 0     0 0   my $cd=shift;
246 0 0         $CD_DEVICE = $cd if (defined($cd));
247              
248 0           my @toc=read_toc($CD_DEVICE);
249 0           my $total=$#toc;
250              
251 0           my $id=cddb_discid($total,\@toc);
252              
253 0           return [$id,$total,\@toc];
254             }
255              
256             sub get_cddb {
257 0     0 0   my $config=shift;
258 0           my $diskid=shift;
259 0           my $id;
260             my $toc;
261 0           my $total;
262 0           my @r;
263              
264 0           my $input = $config->{input};
265 0           my $multi = $config->{multi};
266 0 0         $input = 0 if $multi;
267              
268 0 0         print STDERR Dumper($config) if $debug;
269              
270 0 0         $CDDB_HOST = $config->{CDDB_HOST} if (defined($config->{CDDB_HOST}));
271 0 0         $CDDB_PORT = $config->{CDDB_PORT} if (defined($config->{CDDB_PORT}));
272 0 0         $CDDB_MODE = $config->{CDDB_MODE} if (defined($config->{CDDB_MODE}));
273 0 0         $CD_DEVICE = $config->{CD_DEVICE} if (defined($config->{CD_DEVICE}));
274 0 0         $HELLO_ID = $config->{HELLO_ID} if (defined($config->{HELLO_ID}));
275 0 0         $PROTO_VERSION = $config->{PROTO_VERSION} if (defined($config->{PROTO_VERSION}));
276 0 0         my $HTTP_PROXY = $config->{HTTP_PROXY} if (defined($config->{HTTP_PROXY}));
277 0 0         my $FW=1 if (defined($config->{FW}));
278            
279 0 0         if(defined($diskid)) {
280 0           $id=$diskid->[0];
281 0           $total=$diskid->[1];
282 0           $toc=$diskid->[2];
283             } else {
284 0           my $diskid=get_discids($CD_DEVICE);
285 0           $id=$diskid->[0];
286 0           $total=$diskid->[1];
287 0           $toc=$diskid->[2];
288             }
289              
290 0           my @list=();
291 0           my $return;
292             my $socket;
293              
294 0           my $id2 = sprintf "%08x", $id;
295 0           my $query = "cddb query $id2 $total";
296 0           for (my $i=0; $i<$total ;$i++) {
297 0           $query.=" $toc->[$i]->{frames}";
298             }
299              
300             # this was to old total calculation, does not work too well, its included if new version makes problems
301             # $query.=" ". int(($toc->[$total]->{frames}-$toc->[0]->{frames})/75);
302              
303 0           $query.=" ". int(($toc->[$total]->{frames})/75);
304              
305 0 0         print Dumper($toc) if $debug;
306              
307 0 0         if ($CDDB_MODE eq "cddb") {
    0          
308 0 0         print STDERR "cddb: connecting to $CDDB_HOST:$CDDB_PORT\n" if $debug;
309              
310 0 0         $socket=IO::Socket::INET->new(PeerAddr=>$CDDB_HOST, PeerPort=>$CDDB_PORT,
311             Proto=>"tcp",Type=>SOCK_STREAM) or die "cannot connect to cddb db: $CDDB_HOST:$CDDB_PORT [$!]";
312              
313 0           $return=<$socket>;
314 0 0         unless ($return =~ /^2\d\d\s+/) {
315 0           die "not welcome at cddb db";
316             }
317              
318 0           print $socket "cddb hello $HELLO_ID\n";
319              
320 0           $return=<$socket>;
321 0 0         print STDERR "hello return: $return" if $debug;
322 0 0         unless ($return =~ /^2\d\d\s+/) {
323 0           die "handshake error at cddb db: $CDDB_HOST:$CDDB_PORT";
324             }
325              
326 0           print $socket "proto $PROTO_VERSION\n";
327              
328 0           $return=<$socket>;
329 0 0         print STDERR "proto return: $return" if $debug;
330 0 0         unless ($return =~ /^2\d\d\s+/) {
331 0           die "protokoll mismatch error at cddb db: $CDDB_HOST:$CDDB_PORT";
332             }
333            
334 0 0         print STDERR "cddb: sending: $query\n" if $debug;
335 0           print $socket "$query\n";
336              
337 0           $return=<$socket>;
338 0           chomp $return;
339              
340 0 0         print STDERR "cddb: result: $return\n" if $debug;
341             } elsif ($CDDB_MODE eq "http") {
342 0           my $query2=$query;
343 0           $query2 =~ s/ /+/g;
344 0           my $id=$HELLO_ID;
345 0           $id =~ s/ /+/g;
346              
347 0           my $url = "/~cddb/cddb.cgi?cmd=$query2&hello=$id&proto=$PROTO_VERSION";
348              
349 0           my $host=$CDDB_HOST;
350 0           my $port=80;
351              
352 0           my ($user,$pass);
353              
354 0 0         if($HTTP_PROXY) {
355 0 0         if($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(.+)\@(.+?):(.+)/) {
    0          
356 0           $user=$2;
357 0           $pass=$3;
358 0           $host=$4;
359 0           $port=$5;
360             } elsif($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(\d+)/) {
361 0           $host=$2;
362 0           $port=$3;
363             }
364 0           $url="http://$CDDB_HOST".$url." HTTP/1.0";
365             }
366              
367 0 0         print STDERR "cddb: connecting to $host:$port\n" if $debug;
368              
369 0 0         $socket=IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port,
370             Proto=>"tcp",Type=>SOCK_STREAM) or die "cannot connect to cddb db: $host:$port [$!]";
371              
372 0 0         print STDERR "cddb: http send: GET $url\n" if $debug;
373 0           print $socket "GET $url\n";
374              
375 0 0         if($user) {
376 0           my $cred = encode_base64("$user:$pass");
377 0           print $socket "Proxy-Authorization: Basic $cred\n";
378             }
379              
380 0           print $socket "\n";
381 0 0         print $socket "\n" if $FW;
382              
383 0 0         if($HTTP_PROXY) {
384 0           while(<$socket> =~ /^\S+/){};
385             }
386              
387 0           $return=<$socket>;
388 0           chomp $return;
389              
390 0 0         print STDERR "cddb: http result: $return\n" if $debug;
391             } else {
392 0           die "unkown mode: $CDDB_MODE for querying cddb";
393             }
394              
395 0           $return =~ s/\r//g;
396              
397 0           my ($err) = $return =~ /^(\d\d\d)\s+/;
398 0 0         unless ($err =~ /^2/) {
399 0           die "query error at cddb db: $CDDB_HOST:$CDDB_PORT";
400             }
401              
402 0 0 0       if($err==202) {
    0          
    0          
403 0           return undef;
404             } elsif(($err==211) || ($err==210)) {
405 0           while(<$socket>) {
406 0 0         last if(/^\./);
407 0           push @list,$_;
408 0           s/\r//g;
409 0 0         print STDERR "unexact: $_" if $debug;
410             }
411             } elsif($err==200) {
412 0           $return =~ s/^200 //;
413 0           push @list,$return;
414             } else {
415 0           die "cddb: unknown: $return";
416             }
417              
418 0           my @to_get;
419              
420 0 0         unless($multi) {
421 0 0         if (@list) {
422 0           my $index;
423 0 0         if($input==1) {
424 0           print "This CD could be:\n\n";
425 0           my $i=1;
426 0           for(@list) {
427 0           my ($tit) = $_ =~ /^\S+\s+\S+\s+(.*)/;
428 0           print "$i: $tit\n";
429 0           $i++
430             }
431 0           print "\n0: none of the above\n\nChoose: ";
432 0           my $n=;
433 0           $index=int($n);
434             } else {
435 0           $index=1;
436             }
437              
438 0 0         if ($index == 0) {
439 0           return undef;
440             } else {
441 0           push @to_get,$list[$index-1];
442             }
443             }
444             } else {
445 0           push @to_get,@list;
446             }
447              
448 0           my $i=0;
449 0           for my $get (@to_get) {
450             #200 misc 0a01e802 Meredith Brooks / Bitch Single
451 0           my ($cat,$id,$at) = $get =~ /^(\S+?)\s+(\S+?)\s+(.*)/;
452              
453 0           my $artist;
454             my $title;
455              
456 0 0         if($at =~ /\//) {
457 0           ($artist,$title)= $at =~ /^(.*?)\s\/\s(.*)/;
458             } else {
459 0           $artist=$at;
460 0           $title=$at;
461             }
462              
463 0           my %cd=();
464 0           $cd{artist}=$artist;
465 0           chomp $title;
466 0           $title =~ s/\r//g;
467 0           $cd{title}=$title;
468 0           $cd{cat}=$cat;
469 0           $cd{id}=$id;
470              
471 0           my @lines;
472              
473 0           $query="cddb read $cat $id";
474              
475 0 0         if ($CDDB_MODE eq "cddb") {
    0          
476 0 0         print STDERR "cddb: getting: $query\n" if $debug;
477 0           print $socket "$query\n";
478              
479 0           while(<$socket>) {
480 0 0         last if(/^\./);
481 0           push @lines,$_;
482             }
483 0 0         if(@to_get-1 == $i) {
484 0           print $socket "quit\n";
485 0           close $socket;
486             }
487              
488             } elsif ($CDDB_MODE eq "http") {
489 0           close $socket;
490              
491 0           my $query2=$query;
492 0           $query2 =~ s/ /+/g;
493 0           my $id=$HELLO_ID;
494 0           $id =~ s/ /+/g;
495              
496 0           my $url = "/~cddb/cddb.cgi?cmd=$query2&hello=$id&proto=$PROTO_VERSION";
497              
498 0           my $host=$CDDB_HOST;
499 0           my $port=80;
500              
501 0           my ($user,$pass);
502              
503 0 0         if($HTTP_PROXY) {
504 0 0         if($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(.+)\@(.+?):(.+)/) {
    0          
505 0           $user=$2;
506 0           $pass=$3;
507 0           $host=$4;
508 0           $port=$5;
509             } elsif($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(\d+)/) {
510 0           $host=$2;
511 0           $port=$3;
512             }
513 0           $url="http://$CDDB_HOST".$url." HTTP/1.0";
514             }
515              
516 0 0         print STDERR "cddb: connecting to $host:$port\n" if $debug;
517              
518 0 0         $socket=IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port,
519             Proto=>"tcp",Type=>SOCK_STREAM) or die "cannot connect to cddb db: $host:$port [$!]";
520              
521 0 0         print STDERR "cddb: http send: GET $url\n" if $debug;
522 0           print $socket "GET $url\n";
523              
524 0 0         if($user) {
525 0           my $cred = encode_base64("$user:$pass");
526 0           print $socket "Proxy-Authorization: Basic $cred\n";
527             }
528              
529 0           print $socket "\n";
530 0 0         print $socket "\n" if $FW;
531              
532 0 0         if($HTTP_PROXY) {
533 0           while(<$socket> =~ /^\S+/){};
534             }
535              
536 0           while(<$socket>) {
537 0 0         last if(/^\./);
538 0           push @lines,$_;
539             }
540 0           close $socket;
541             } else {
542 0           die "unkown mode: $CDDB_MODE for querying cddb";
543             }
544              
545             # xmcd
546             #
547             # Track frame offsets:
548             # 150
549             # ...
550             # 210627
551             #
552             # Disc length: 2952 seconds
553             #
554             # Revision: 1
555             # Submitted via: xmcd 2.0
556             #
557              
558 0           for(@lines) {
559 0 0         last if(/^\./);
560 0 0         next if(/^\d\d\d/);
561 0           push @{$cd{raw}},$_;
  0            
562             #TTITLE0=Bitch (Edit)
563 0 0         if(/^TTITLE(\d+)\=\s*(.*)/) {
    0          
    0          
    0          
564 0           my $t= $2;
565 0           chop $t;
566 0           $cd{frames}[$1]=$toc->[$1]->{frames};
567 0           $cd{data}[$1]=$toc->[$1]->{data};
568 0 0         unless (defined $cd{track}[$1]) {
569 0           $cd{track}[$1]=$t;
570             } else {
571 0           $cd{track}[$1]=$cd{track}[$1].$t;
572             }
573             } elsif(/^DYEAR=\s*(\d+)/) {
574 0           $cd{'year'} = $1;
575             } elsif(/^DGENRE=\s*(\S+.*)/) {
576 0           my $t = $1;
577 0           chop $t;
578 0           $cd{'genre'} = $t;
579             } elsif(/^\#\s+Revision:\s+(\d+)/) {
580 0           $cd{'revision'} = $1;
581             }
582             }
583              
584 0           $cd{tno}=$#{$cd{track}}+1;
  0            
585 0           $cd{frames}[$cd{tno}]=$toc->[$cd{tno}]->{frames};
586            
587 0 0         return %cd unless($multi);
588 0           push @r,\%cd;
589 0           $i++;
590             }
591              
592 0           return @r;
593             }
594              
595             1;
596             __END__