1# Documentation and Copyright exist after __END__ 2 3package CDDB; 4require 5.001; 5 6use strict; 7use vars qw($VERSION); 8use Carp; 9 10$VERSION = '1.220'; 11 12BEGIN { 13 if ($^O eq 'MSWin32') { 14 eval 'sub USING_WINDOWS () { 1 }'; 15 } 16 else { 17 eval 'sub USING_WINDOWS () { 0 }'; 18 } 19} 20 21use IO::Socket; 22use Sys::Hostname; 23 24# A list of known freedb servers. I've stopped using Gracenote's CDDB 25# because they never return my e-mail about becoming a developer. To 26# top it off, they've started denying CDDB.pm users. 27# TODO: Fetch the list from freedb.freedb.org, which is a round-robin 28# for all the others anyway. 29 30my $cddbp_host_selector = 0; 31 32my @cddbp_hosts = ( 33 [ 'localhost' => 8880 ], 34 [ 'freedb.freedb.org' => 8880 ], 35 [ 'us.freedb.org', => 8880 ], 36 [ 'ca.freedb.org', => 8880 ], 37 [ 'ca2.freedb.org', => 8880 ], 38 [ 'uk.freedb.org' => 8880 ], 39 [ 'no.freedb.org' => 8880 ], 40 [ 'de.freedb.org' => 8880 ], 41 [ 'at.freedb.org' => 8880 ], 42 [ 'freedb.freedb.de' => 8880 ], 43); 44 45#------------------------------------------------------------------------------ 46# Determine whether we can submit changes by e-mail. 47 48my $imported_mail = 0; 49eval { 50 require Mail::Internet; 51 require Mail::Header; 52 require MIME::QuotedPrint; 53 $imported_mail = 1; 54}; 55 56#------------------------------------------------------------------------------ 57# Determine whether we can use HTTP for requests and submissions. 58 59my $imported_http = 0; 60eval { 61 require LWP; 62 require HTTP::Request; 63 $imported_http = 1; 64}; 65 66#------------------------------------------------------------------------------ 67# Send a command. If we're not connected, try to connect first. 68# Returns 1 if the command is sent ok; 0 if there was a problem. 69 70sub command { 71 my $self = shift; 72 my $str = join(' ', @_); 73 74 unless ($self->{handle}) { 75 $self->connect() or return 0; 76 } 77 78 $self->debug_print(0, '>>> ', $str); 79 80 my $len = length($str .= "\x0D\x0A"); 81 82 local $SIG{PIPE} = 'IGNORE' unless ($^O eq 'MacOS'); 83 return 0 unless(syswrite($self->{handle}, $str, $len) == $len); 84 return 1; 85} 86 87#------------------------------------------------------------------------------ 88# Retrieve a line from the server. Uses a buffer to allow for 89# ungetting lines. Returns the next line or undef if there is a 90# problem. 91 92sub getline { 93 my $self = shift; 94 95 if (@{$self->{lines}}) { 96 my $line = shift @{$self->{lines}}; 97 $self->debug_print(0, '<<< ', $line); 98 return $line; 99 } 100 101 my $socket = $self->{handle}; 102 return unless defined $socket; 103 104 my $fd = fileno($socket); 105 return unless defined $fd; 106 107 vec(my $rin = '', $fd, 1) = 1; 108 my $timeout = $self->{timeout} || undef; 109 my $frame = $self->{frame}; 110 111 until (@{$self->{lines}}) { 112 113 # Fail if the socket is inactive for the timeout period. Fail 114 # also if sysread returns nothing. 115 116 return unless select(my $rout=$rin, undef, undef, $timeout); 117 return unless defined sysread($socket, my $buf='', 1024); 118 119 $frame .= $buf; 120 my @lines = split(/\x0D?\x0A/, $frame); 121 $frame = ( 122 (length($buf) == 0 || substr($buf, -1, 1) eq "\x0A") 123 ? '' 124 : pop(@lines) 125 ); 126 push @{$self->{lines}}, map { decode('utf8', $_) } @lines; 127 } 128 129 $self->{frame} = $frame; 130 131 my $line = shift @{$self->{lines}}; 132 $self->debug_print(0, '<<< ', $line); 133 return $line; 134} 135 136#------------------------------------------------------------------------------ 137# Receive a server response, and parse it into its numeric code and 138# text message. Return the code's first character, which usually 139# indicates the response class (ok, error, information, warning, 140# etc.). Returns undef on failure. 141 142sub response { 143 my $self = shift; 144 my ($code, $text); 145 146 my $str = $self->getline(); 147 148 return unless defined($str); 149 150 # Fail if the line we get isn't the proper format. 151 return unless ( ($code, $text) = ($str =~ /^(\d+)\s*(.*?)\s*$/) ); 152 153 $self->{response_code} = $code; 154 $self->{response_text} = $text; 155 substr($code, 0, 1); 156} 157 158#------------------------------------------------------------------------------ 159# Accessors to retrieve the last response() call's code and text 160# separately. 161 162sub code { 163 my $self = shift; 164 $self->{response_code}; 165} 166 167sub text { 168 my $self = shift; 169 $self->{response_text}; 170} 171 172#------------------------------------------------------------------------------ 173# Helper to print stuff for debugging. 174 175sub debug_print { 176 my $self = shift; 177 178 # Don't bother if not debugging. 179 return unless $self->{debug}; 180 181 my $level = shift; 182 my $text = join('', @_); 183 print STDERR $text, "\n"; 184} 185 186#------------------------------------------------------------------------------ 187# Read data until it's terminated by a single dot on its own line. 188# Two dots at the start of a line are replaced by one. Returns an 189# ARRAY reference containing the lines received, or undef on error. 190 191sub read_until_dot { 192 my $self = shift; 193 my @lines; 194 195 while ('true') { 196 my $line = $self->getline() or return; 197 last if ($line =~ /^\.$/); 198 $line =~ s/^\.\././; 199 push @lines, $line; 200 } 201 202 \@lines; 203} 204 205#------------------------------------------------------------------------------ 206# Create an object to represent one or more cddbp sessions. 207 208sub new { 209 my $type = shift; 210 my %param = @_; 211 212 # Attempt to suss our hostname. 213 my $hostname = &hostname(); 214 215 # Attempt to suss our login ID. 216 my $login = $param{Login} || $ENV{LOGNAME} || $ENV{USER}; 217 if (not defined $login) { 218 if (USING_WINDOWS) { 219 carp( 220 "Can't get login ID. Use Login parameter or " . 221 "set LOGNAME or USER environment variable. Using default login " . 222 "ID 'win32usr'" 223 ); 224 $login = 'win32usr'; 225 } 226 else { 227 $login = getpwuid($>) 228 or croak( 229 "Can't get login ID. " . 230 "Set LOGNAME or USER environment variable and try again: $!" 231 ); 232 } 233 } 234 235 # Debugging flag. 236 my $debug = $param{Debug}; 237 $debug = 0 unless defined $debug; 238 239 # Choose a particular cddbp host. 240 my $host = $param{Host}; 241 $host = '' unless defined $host; 242 243 # Choose a particular cddbp port. 244 my $port = $param{Port}; 245 $port = 8880 unless $port; 246 247 # Choose a particular cddbp submission address. 248 my $submit_to = $param{Submit_Address}; 249 $submit_to = 'freedb-submit@freedb.org' unless defined $submit_to; 250 251 # Change the cddbp client name. 252 my $client_name = $param{Client_Name}; 253 $client_name = 'CDDB.pm' unless defined $client_name; 254 255 # Change the cddbp client version. 256 my $client_version = $param{Client_Version}; 257 $client_version = $VERSION unless defined $client_version; 258 259 # Whether to use utf-8 for submission 260 my $utf8 = $param{Utf8}; 261 $utf8 = 1 unless defined $utf8; 262 if ($utf8) { 263 eval { 264 require Encode; 265 import Encode; 266 }; 267 if ( $@ ) { 268 carp 'Unable to load the Encode module, falling back to ascii'; 269 $utf8 = 0; 270 } 271 } 272 273 eval 'sub encode { $_[1] };sub decode { $_[1] }' unless $utf8; 274 275 # Change the cddbp protocol level. 276 my $cddb_protocol = $param{Protocol_Version}; 277 $cddb_protocol = ($utf8 ? 6 : 1) unless defined $cddb_protocol; 278 carp <<EOF if $utf8 and $cddb_protocol < 6; 279You have requested protocol level $cddb_protocol. However, 280utf-8 support is only available starting from level 6 281EOF 282 283 # Mac Freaks Got Spaces! Augh! 284 $login =~ s/\s+/_/g; 285 286 my $self = bless { 287 hostname => $hostname, 288 login => $login, 289 mail_from => undef, 290 mail_host => undef, 291 libname => $client_name, 292 libver => $client_version, 293 cddbmail => $submit_to, 294 debug => $debug, 295 host => $host, 296 port => $port, 297 cddb_protocol => $cddb_protocol, 298 utf8 => $utf8, 299 lines => [], 300 frame => '', 301 response_code => '000', 302 response_text => '', 303 }, $type; 304 305 $self; 306} 307 308#------------------------------------------------------------------------------ 309# Disconnect from a cddbp server. This is needed sometimes when a 310# server decides a session has performed enough requests. 311 312sub disconnect { 313 my $self = shift; 314 if ($self->{handle}) { 315 $self->command('quit'); # quit 316 $self->response(); # wait for any response 317 delete $self->{handle}; # close the socket 318 } 319 else { 320 $self->debug_print( 0, '--- disconnect on unconnected handle' ); 321 } 322} 323 324#------------------------------------------------------------------------------ 325# Connect to a cddbp server. Connecting and disconnecting are done 326# transparently and are performed on the basis of need. Furthermore, 327# this routine will cycle through servers until one connects or it has 328# exhausted all its possibilities. Returns true if successful, or 329# false if failed. 330 331sub connect { 332 my $self = shift; 333 my $cddbp_host; 334 335 # Try to get our hostname yet again, in case it failed during the 336 # constructor call. 337 unless (defined $self->{hostname}) { 338 $self->{hostname} = &hostname() or croak "can't get hostname: $!"; 339 } 340 341 # The handshake loop tries to complete an entire connection 342 # negociation. It loops until success, or until HOST returns 343 # because all the hosts have failed us. 344 345 HANDSHAKE: while ('true') { 346 347 # Loop through the CDDB protocol hosts list up to twice in order 348 # to find a server that will respond. This implements a 2x retry. 349 350 HOST: for (1..(@cddbp_hosts * 2)) { 351 352 # Hard disconnect here to prevent recursion. 353 delete $self->{handle}; 354 355 ($self->{host}, $self->{port}) = @{$cddbp_hosts[$cddbp_host_selector]}; 356 357 # Assign the host we selected, and attempt a connection. 358 $self->debug_print( 359 0, 360 "=== connecting to $self->{host} port $self->{port}" 361 ); 362 $self->{handle} = new IO::Socket::INET( 363 PeerAddr => $self->{host}, 364 PeerPort => $self->{port}, 365 Proto => 'tcp', 366 Timeout => 30, 367 ); 368 369 # The host did not answer. Clean up after the failed attempt 370 # and cycle to the next host. 371 unless (defined $self->{handle}) { 372 $self->debug_print( 373 0, 374 "--- error connecting to $self->{host} port $self->{port}: $!" 375 ); 376 377 delete $self->{handle}; 378 $self->{host} = $self->{port} = ''; 379 380 # Try the next host in the list. Wrap if necessary. 381 $cddbp_host_selector = 0 if ++$cddbp_host_selector > @cddbp_hosts; 382 383 next HOST; 384 } 385 386 # The host accepted our connection. We'll push it back on the 387 # list of known cddbp hosts so it can be tried later. And we're 388 # done with the host list cycle for now. 389 $self->debug_print( 390 0, 391 "+++ successfully connected to $self->{host} port $self->{port}" 392 ); 393 394 last HOST; 395 } 396 397 # Tried the whole list twice without success? Time to give up. 398 unless (defined $self->{handle}) { 399 $self->debug_print( 0, "--- all cddbp servers failed to answer" ); 400 warn "No cddb protocol servers answer. Is your network OK?\n" 401 unless $self->{debug}; 402 return; 403 } 404 405 # Turn off buffering on the socket handle. 406 select((select($self->{handle}), $|=1)[0]); 407 408 # Get the server's banner message. Try reconnecting if it's bad. 409 my $code = $self->response(); 410 if ($code != 2) { 411 $self->debug_print( 412 0, "--- bad cddbp response: ", 413 $self->code(), ' ', $self->text() 414 ); 415 next HANDSHAKE; 416 } 417 418 # Say hello, and wait for a response. 419 $self->command( 420 'cddb hello', 421 $self->{login}, $self->{hostname}, 422 $self->{libname}, $self->{libver} 423 ); 424 $code = $self->response(); 425 if ($code == 4) { 426 $self->debug_print( 427 0, "--- the server denies us: ", 428 $self->code(), ' ', $self->text() 429 ); 430 return; 431 } 432 if ($code != 2) { 433 $self->debug_print( 434 0, "--- the server didn't handshake: ", 435 $self->code(), ' ', $self->text() 436 ); 437 next HANDSHAKE; 438 } 439 440 # Set the protocol level. 441 if ($self->{cddb_protocol} != 1) { 442 $self->command( 'proto', $self->{cddb_protocol} ); 443 $code = $self->response(); 444 if ($code != 2) { 445 $self->debug_print( 446 0, "--- can't set protocol level ", 447 $self->{cddb_protocol}, ' ', 448 $self->code(), ' ', $self->text() 449 ); 450 return; 451 } 452 } 453 454 # If we get here, everything succeeded. 455 return 1; 456 } 457} 458 459# Destroying the cddbp object disconnects from the server. 460 461sub DESTROY { 462 my $self = shift; 463 $self->disconnect(); 464} 465 466############################################################################### 467# High-level cddbp functions. 468 469#------------------------------------------------------------------------------ 470# Get a list of available genres. Returns an array of genre names, or 471# undef on failure. 472 473sub get_genres { 474 my $self = shift; 475 my @genres; 476 477 $self->command('cddb lscat'); 478 my $code = $self->response(); 479 return unless $code; 480 481 if ($code == 2) { 482 my $genres = $self->read_until_dot(); 483 return @$genres if defined $genres; 484 return; 485 } 486 487 $self->debug_print( 488 0, '--- error listing categories: ', 489 $self->code(), ' ', $self->text() 490 ); 491 return; 492} 493 494#------------------------------------------------------------------------------ 495# Calculate a cddbp ID based on a text table of contents. The text 496# format was chosen because it was straightforward and easy to 497# generate. In a scalar context, this returns just the cddbp ID. In 498# a list context it returns several things: a listref of track 499# numbers, a listref of track lengths (MM:SS format), a listref of 500# track offsets (in seconds), and the disc's total playing time in 501# seconds. In either context it returns undef on failure. 502 503sub calculate_id { 504 my $self = shift; 505 my @toc = @_; 506 507 my ( 508 $seconds_previous, $seconds_first, $seconds_last, $cddbp_sum, 509 @track_numbers, @track_lengths, @track_offsets, 510 ); 511 512 foreach my $line (@toc) { 513 my ($track, $mm_begin, $ss_begin, $ff_begin) = split(/\s+/, $line, 4); 514 my $frame_offset = (($mm_begin * 60 + $ss_begin) * 75) + $ff_begin; 515 my $seconds_begin = int($frame_offset / 75); 516 517 if (defined $seconds_previous) { 518 my $elapsed = $seconds_begin - $seconds_previous; 519 push( 520 @track_lengths, 521 sprintf("%02d:%02d", int($elapsed / 60), $elapsed % 60) 522 ); 523 } 524 else { 525 $seconds_first = $seconds_begin; 526 } 527 528 # Track 999 was chosen for the lead-out information. 529 if ($track == 999) { 530 $seconds_last = $seconds_begin; 531 last; 532 } 533 534 # Track 1000 was chosen for error information. 535 if ($track == 1000) { 536 $self->debug_print( 0, "error in TOC: $ff_begin" ); 537 return; 538 } 539 540 map { $cddbp_sum += $_; } split(//, $seconds_begin); 541 push @track_offsets, $frame_offset; 542 push @track_numbers, sprintf("%03d", $track); 543 $seconds_previous = $seconds_begin; 544 } 545 546 # Calculate the ID. Whee! 547 my $id = sprintf( 548 "%02x%04x%02x", 549 ($cddbp_sum % 255), 550 $seconds_last - $seconds_first, 551 scalar(@track_offsets) 552 ); 553 554 # In list context, we return several things. Some of them are 555 # useful for generating filenames or playlists (the padded track 556 # numbers). Others are needed for cddbp queries. 557 return ( 558 $id, \@track_numbers, \@track_lengths, \@track_offsets, $seconds_last 559 ) if wantarray(); 560 561 # Just return the cddbp ID in scalar context. 562 return $id; 563} 564 565#------------------------------------------------------------------------------ 566# Parse cdinfo's output so calculate_id() can eat it. 567 568sub parse_cdinfo { 569 my ($self, $command) = @_; 570 open(FH, $command) or croak "could not open `$command': $!"; 571 572 my @toc; 573 while (<FH>) { 574 if (/(\d+):\s+(\d+):(\d+):(\d+)/) { 575 my @track = ($1,$2,$3,$4); 576 $track[0] = 999 if /leadout/; 577 push @toc, "@track"; 578 } 579 } 580 close FH; 581 return @toc; 582} 583 584#------------------------------------------------------------------------------ 585# Get a list of discs that match a particular CD's table of contents. 586# This accepts the TOC information as returned by calculate_id(). It 587# will also accept information in mp3 format, but I forget what that 588# is. Pudge asked for it, so he'd know. 589 590sub get_discs { 591 my $self = shift; 592 my ($id, $offsets, $total_seconds) = @_; 593 594 # Accept the TOC in CDDB.pm format. 595 my ($track_count, $offsets_string); 596 if (ref($offsets) eq 'ARRAY') { 597 $track_count = scalar(@$offsets); 598 $offsets_string = join ' ', @$offsets; 599 } 600 601 # Accept the TOC in mp3 format, for pudge. 602 else { 603 $offsets =~ /^(\d+?)\s+(.*)$/; 604 $track_count = $1; 605 $offsets_string = $2; 606 } 607 608 # Make repeated attempts to query the server. I do this to drive 609 # the hidden server cycling. 610 my $code; 611 612 ATTEMPT: while ('true') { 613 614 # Send a cddbp query command. 615 $self->command( 616 'cddb query', $id, $track_count, 617 $offsets_string, $total_seconds 618 ) or return; 619 620 # Get the response. Try again if the server is temporarly 621 # unavailable. 622 $code = $self->response(); 623 next ATTEMPT if $self->code() == 417; 624 last ATTEMPT; 625 } 626 627 # Return undef if there's a problem. 628 return unless defined $code and $code == 2; 629 630 # Single matching disc. 631 if ($self->code() == 200) { 632 my ($genre, $cddbp_id, $title) = ( 633 $self->text() =~ /^(\S+)\s*(\S+)\s*(.*?)\s*$/ 634 ); 635 return [ $genre, $cddbp_id, $title ]; 636 } 637 638 # No matching discs. 639 return if $self->code() == 202; 640 641 # Multiple matching discs. 642 # 210 Found exact matches, list follows (...) [proto>=4] 643 # 211 Found inexact matches, list follows (...) [proto>=1] 644 if ($self->code() == 210 or $self->code() == 211) { 645 my $discs = $self->read_until_dot(); 646 return unless defined $discs; 647 648 my @matches; 649 foreach my $disc (@$discs) { 650 my ($genre, $cddbp_id, $title) = ($disc =~ /^(\S+)\s*(\S+)\s*(.*?)\s*$/); 651 push(@matches, [ $genre, $cddbp_id, $title ]); 652 } 653 654 return @matches; 655 } 656 657 # What the heck? 658 $self->debug_print( 659 0, "--- unknown cddbp response: ", 660 $self->code(), ' ', $self->text() 661 ); 662 return; 663} 664 665#------------------------------------------------------------------------------ 666# A little helper to combine list-context calculate_id() with 667# get_discs(). 668 669sub get_discs_by_toc { 670 my $self = shift; 671 my (@info, @discs); 672 if (@info = $self->calculate_id(@_)) { 673 @discs = $self->get_discs(@info[0, 3, 4]); 674 } 675 @discs; 676} 677 678#------------------------------------------------------------------------------ 679# A little helper to get discs from an existing query string. 680# Contributed by Ron Grabowski. 681 682sub get_discs_by_query { 683 my ($self, $query) = @_; 684 my (undef, undef, $cddbp_id, $tracks, @offsets) = split /\s+/, $query; 685 my $total_seconds = pop @offsets; 686 my @discs = $self->get_discs($cddbp_id, \@offsets, $total_seconds); 687 return @discs; 688} 689 690#------------------------------------------------------------------------------ 691# Retrieve the database record for a particular genre/id combination. 692# Returns a moderately complex hashref representing the cddbp record, 693# or undef on failure. 694 695sub get_disc_details { 696 my $self = shift; 697 my ($genre, $id) = @_; 698 699 # Because cddbp only allows one detail query per connection, we 700 # force a disconnect/reconnect here if we already did one. 701 if (exists $self->{'got tracks before'}) { 702 $self->disconnect(); 703 $self->connect() or return; 704 } 705 $self->{'got tracks before'} = 'yes'; 706 707 $self->command('cddb read', $genre, $id); 708 my $code = $self->response(); 709 if ($code != 2) { 710 $self->debug_print( 711 0, "--- cddbp host could not read the disc record: ", 712 $self->code(), ' ', $self->text() 713 ); 714 return; 715 } 716 717 my $track_file; 718 unless (defined($track_file = $self->read_until_dot())) { 719 $self->debug_print( 0, "--- cddbp disc record interrupted" ); 720 return; 721 } 722 723 # Parse that puppy. 724 return parse_xmcd_file($track_file, $genre); 725} 726 727# Arf! 728 729sub parse_xmcd_file { 730 my ($track_file, $genre) = @_; 731 732 my %details = ( 733 offsets => [ ], 734 seconds => [ ], 735 ); 736 my $state = 'beginning'; 737 foreach my $line (@$track_file) { 738 # Keep returned so-called xmcd record... 739 $details{xmcd_record} .= $line . "\n"; 740 741 if ($state eq 'beginning') { 742 if ($line =~ /track\s*frame\s*off/i) { 743 $state = 'offsets'; 744 } 745 next; 746 } 747 748 if ($state eq 'offsets') { 749 if ($line =~ /^\#\s*(\d+)/) { 750 push @{$details{offsets}}, $1; 751 next; 752 } 753 $state = 'headers'; 754 # This passes through on purpose. 755 } 756 757 # This is not an elsif on purpose. 758 if ($state eq 'headers') { 759 if ($line =~ /^\#/) { 760 $line =~ s/\s+/ /g; 761 if (my ($header, $value) = ($line =~ /^\#\s*(.*?)\:\s*(.*?)\s*$/)) { 762 $details{lc($header)} = $value; 763 } 764 next; 765 } 766 $state = 'data'; 767 # This passes through on purpose. 768 } 769 770 # This is not an elsif on purpose. 771 if ($state eq 'data') { 772 next unless ( 773 my ($tag, $idx, $val) = ($line =~ /^\s*(.+?)(\d*)\s*\=\s*(.+?)\s*$/) 774 ); 775 $tag = lc($tag); 776 777 if ($idx ne '') { 778 $tag .= 's'; 779 $details{$tag} = [ ] unless exists $details{$tag}; 780 $details{$tag}->[$idx] .= $val; 781 $details{$tag}->[$idx] =~ s/^\s+//; 782 $details{$tag}->[$idx] =~ s/\s+$//; 783 $details{$tag}->[$idx] =~ s/\s+/ /g; 784 } 785 else { 786 $details{$tag} .= $val; 787 $details{$tag} =~ s/^\s+//; 788 $details{$tag} =~ s/\s+$//; 789 $details{$tag} =~ s/\s+/ /g; 790 } 791 } 792 } 793 794 # Translate disc offsets into seconds. This builds a virtual track 795 # 0, which is the time from the beginning of the disc to the 796 # beginning of the first song. That time's used later to calculate 797 # the final track's length. 798 799 my $last_offset = 0; 800 foreach (@{$details{offsets}}) { 801 push @{$details{seconds}}, int(($_ - $last_offset) / 75); 802 $last_offset = $_; 803 } 804 805 # Create the final track length from the disc length. Remove the 806 # virtual track 0 in the process. 807 808 my $disc_length = $details{"disc length"}; 809 $disc_length =~ s/ .*$//; 810 811 my $first_start = shift @{$details{seconds}}; 812 push( 813 @{$details{seconds}}, 814 $disc_length - int($details{offsets}->[-1] / 75) + 1 - $first_start 815 ); 816 817 # Add the genre, if we have it. 818 $details{genre} = $genre; 819 820 return \%details; 821} 822 823############################################################################### 824# Evil voodoo e-mail submission stuff. 825 826#------------------------------------------------------------------------------ 827# Return true/false whether the libraries needed to submit discs are 828# present. 829 830sub can_submit_disc { 831 my $self = shift; 832 $imported_mail; 833} 834 835#------------------------------------------------------------------------------ 836# Build an e-mail address, and return it. Caches the last built 837# address, and returns that on subsequent calls. 838 839sub get_mail_address { 840 my $self = shift; 841 return $self->{mail_from} if defined $self->{mail_from}; 842 return $self->{mail_from} = $self->{login} . '@' . $self->{hostname}; 843} 844 845#------------------------------------------------------------------------------ 846# Build an e-mail host, and return it. Caches the last built e-mail 847# host, and returns that on subsequent calls. 848 849sub get_mail_host { 850 my $self = shift; 851 852 return $self->{mail_host} if defined $self->{mail_host}; 853 854 if (exists $ENV{SMTPHOSTS}) { 855 $self->{mail_host} = $ENV{SMTPHOSTS}; 856 } 857 elsif (defined inet_aton('mail')) { 858 $self->{mail_host} = 'mail'; 859 } 860 else { 861 $self->{mail_host} = 'localhost'; 862 } 863 return $self->{mail_host}; 864} 865 866# Build a cddbp disc submission and try to e-mail it. 867 868sub submit_disc { 869 my $self = shift; 870 my %params = @_; 871 872 croak( 873 "submit_disc needs Mail::Internet, Mail::Header, and MIME::QuotedPrint" 874 ) unless $imported_mail; 875 876 # Try yet again to fetch the hostname. Fail if we cannot. 877 unless (defined $self->{hostname}) { 878 $self->{hostname} = &hostname() or croak "can't get hostname: $!"; 879 } 880 881 # Validate the required submission fields. XXX Duplicated code. 882 (exists $params{Genre}) or croak "submit_disc needs a Genre"; 883 (exists $params{Id}) or croak "submit_disc needs an Id"; 884 (exists $params{Artist}) or croak "submit_disc needs an Artist"; 885 (exists $params{DiscTitle}) or croak "submit_disc needs a DiscTitle"; 886 (exists $params{TrackTitles}) or croak "submit_disc needs TrackTitles"; 887 (exists $params{Offsets}) or croak "submit_disc needs Offsets"; 888 (exists $params{Revision}) or croak "submit_disc needs a Revision"; 889 if (exists $params{Year}) { 890 unless ($params{Year} =~ /^\d{4}$/) { 891 croak "submit_disc needs a 4 digit year"; 892 } 893 } 894 if (exists $params{GenreLong}) { 895 unless ($params{GenreLong} =~ /^([A-Z][a-zA-Z0-9]*\s?)+$/) { 896 croak( 897 "GenreLong must start with a capital letter and contain only " . 898 "letters and numbers" 899 ); 900 } 901 } 902 903 # Try to find a mail host. We could probably grab the MX record for 904 # the current machine, but that would require yet more strange 905 # modules. TODO: Use Net::DNS if it's available (why not?) and just 906 # bypass it if it isn't installed. 907 908 $self->{mail_host} = $params{Host} if exists $params{Host}; 909 my $host = $self->get_mail_host(); 910 911 # Override the sender's e-mail address with whatever was specified 912 # during the object's constructor call. 913 $self->{mail_from} = $params{From} if exists $params{From}; 914 my $from = $self->get_mail_address(); 915 916 # Build the submission's headers. 917 my $header = new Mail::Header; 918 $header->add( 'MIME-Version' => '1.0' ); 919 my $charset = $self->{'utf8'} ? 'utf-8' : 'iso-8859-1'; 920 $header->add( 'Content-Type' => "text/plain; charset=$charset" ); 921 $header->add( 'Content-Disposition' => 'inline' ); 922 $header->add( 'Content-Transfer-Encoding' => 'quoted-printable' ); 923 $header->add( From => $from ); 924 $header->add( To => $self->{cddbmail} ); 925 # send a copy to ourselves if we are debugging 926 $header->add( Cc => $from ) if $self->{debug}; 927 $header->add( Subject => "cddb $params{Genre} $params{Id}" ); 928 929 # Build the submission's body. 930 my @message_body = ( 931 '# xmcd', 932 '#', 933 '# Track frame offsets:', 934 map({ "#\t" . $_; } @{$params{Offsets}}), 935 '#', 936 '# Disc length: ' . (hex(substr($params{Id},2,4))+2) . ' seconds', 937 '#', 938 "# Revision: " . $params{Revision}, 939 '# Submitted via: ' . $self->{libname} . ' ' . $self->{libver}, 940 '#', 941 'DISCID=' . $params{Id}, 942 'DTITLE=' . $params{Artist} . ' / ' . $params{DiscTitle}, 943 ); 944 945 # add year and genre 946 if (exists $params{Year}) { 947 push @message_body, 'DYEAR='.$params{Year}; 948 } 949 if (exists $params{GenreLong}) { 950 push @message_body, 'DGENRE='.$params{GenreLong}; 951 } 952 953 # Dump the track titles. 954 my $number = 0; 955 foreach my $title (@{$params{TrackTitles}}) { 956 my $copy = $title; 957 while ($copy ne '') { 958 push( @message_body, 'TTITLE' . $number . '=' . substr($copy, 0, 69)); 959 substr($copy, 0, 69) = ''; 960 } 961 $number++; 962 } 963 964 # Dump extended information. 965 push @message_body, 'EXTD='; 966 push @message_body, map { "EXTT$_="; } (0..--$number); 967 push @message_body, 'PLAYORDER='; 968 969 # Translate the message body to quoted printable. TODO: How can I 970 # ensure that the quoted printable characters are within ISO-8859-1? 971 # The cddbp submissions daemon will barf if it's not. 972 foreach my $line (@message_body) { 973 $line .= "\n"; 974 $line = MIME::QuotedPrint::encode_qp(encode('utf8', $line)); 975 } 976 977 # Bundle the headers and body into an Internet mail. 978 my $mail = new Mail::Internet( 979 undef, 980 Header => $header, 981 Body => \@message_body, 982 ); 983 984 # Try to send it using the "mail" utility. This is commented out: 985 # it strips the MIME headers from the message, invalidating the 986 # submission. 987 988 #eval { 989 # die unless $mail->send( 'mail' ); 990 #}; 991 #return 1 unless $@; 992 993 # Try to send it using "sendmail". 994 eval { 995 die unless $mail->send( 'sendmail' ); 996 }; 997 return 1 unless $@; 998 999 # Try to send it by making a direct SMTP connection. 1000 eval { 1001 die unless $mail->send( smtp => Server => $host ); 1002 }; 1003 return 1 unless $@; 1004 1005 # Augh! Everything failed! 1006 $self->debug_print( 0, '--- could not find a way to submit a disc' ); 1007 return; 1008} 1009 10101; 1011 1012__END__ 1013 1014=head1 NAME 1015 1016CDDB.pm - a high-level interface to cddb protocol servers (freedb and CDDB) 1017 1018=head1 VERSION 1019 1020version 1.222 1021 1022=head1 SYNOPSIS 1023 1024 use CDDB; 1025 1026 ### Connect to the cddbp server. 1027 my $cddbp = new CDDB( 1028 Host => 'freedb.freedb.org', # default 1029 Port => 8880, # default 1030 Login => $login_id, # defaults to %ENV's 1031 ) or die $!; 1032 1033 ### Retrieve known genres. 1034 my @genres = $cddbp->get_genres(); 1035 1036 ### Calculate cddbp ID based on MSF info. 1037 my @toc = ( 1038 '1 0 2 37', # track, CD-i MSF (space-delimited) 1039 '999 1 38 17', # lead-out track MSF 1040 '1000 0 0 Error!', # error track (don't include if ok) 1041 ); 1042 my ( 1043 $cddbp_id, # used for further cddbp queries 1044 $track_numbers, # padded with 0's (for convenience) 1045 $track_lengths, # length of each track, in MM:SS format 1046 $track_offsets, # absolute offsets (used for further cddbp queries) 1047 $total_seconds # total play time, in seconds (for cddbp queries) 1048 ) = $cddbp->calculate_id(@toc); 1049 1050 ### Query discs based on cddbp ID and other information. 1051 my @discs = $cddbp->get_discs($cddbp_id, $track_offsets, $total_seconds); 1052 foreach my $disc (@discs) { 1053 my ($genre, $cddbp_id, $title) = @$disc; 1054 } 1055 1056 ### Query disc details (usually done with get_discs() information). 1057 my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id); 1058 my $disc_time = $disc_info->{'disc length'}; 1059 my $disc_id = $disc_info->{discid}; 1060 my $disc_title = $disc_info->{dtitle}; 1061 my @track_offsets = @{$disc_info->{offsets}}; 1062 my @track_seconds = @{$disc_info->{seconds}}; 1063 my @track_titles = @{$disc_info->{ttitles}}; 1064 # other information may be returned... explore! 1065 1066 ### Submit a disc via e-mail. (Requires MailTools) 1067 1068 die "can't submit a disc (no mail modules; see README)" 1069 unless $cddbp->can_submit_disc(); 1070 1071 # These are useful for prompting the user to fix defaults: 1072 print "I will send mail through: ", $cddbp->get_mail_host(), "\n"; 1073 print "I assume your e-mail address is: ", $cddbp->get_mail_address(), "\n"; 1074 1075 # Actually submit a disc record. 1076 $cddbp->submit_disc( 1077 Genre => 'classical', 1078 Id => 'b811a20c', 1079 Artist => 'Various', 1080 DiscTitle => 'Cartoon Classics', 1081 Offsets => $disc_info->{offsets}, # array reference 1082 TrackTitles => $disc_info->{ttitles}, # array reference 1083 From => 'login@host.domain.etc', # will try to determine 1084 ); 1085 1086=head1 DESCRIPTION 1087 1088CDDB protocol (cddbp) servers provide compact disc information for 1089programs that need it. This allows such programs to display disc and 1090track titles automatically, and it provides extended information like 1091liner notes and lyrics. 1092 1093This module provides a high-level Perl interface to cddbp servers. 1094With it, a Perl program can identify and possibly gather details about 1095a CD based on its "table of contents" (the disc's track times and 1096offsets). 1097 1098Disc details have been useful for generating CD catalogs, naming mp3 1099files, printing CD liners, or even just playing discs in an automated 1100jukebox. 1101 1102Despite the module's name, it connects to FreeDB servers by default. 1103This began at version 1.04, when cddb.com changed its licensing model 1104to support end-user applications, not third-party libraries. 1105Connections to cddb.com may still work, and patches are welcome to 1106maintain that functionality, but it's no longer officially supported. 1107 1108=head1 PUBLIC METHODS 1109 1110=over 4 1111 1112=item new PARAMETERS 1113 1114Creates a high-level interface to a cddbp server, returning a handle 1115to it. The handle is not a filehandle. It is an object. The new() 1116constructor provides defaults for just about everything, but 1117everything is overrideable if the defaults aren't appropriate. 1118 1119The interface will not actually connect to a cddbp server until it's 1120used, and a single cddbp interface may actually make several 1121connections (to possibly several servers) over the course of its use. 1122 1123The new() constructor accepts several parameters, all of which have 1124reasonable defaults. 1125 1126B<Host> and B<Port> describe the cddbp server to connect to. These 1127default to 'freedb.freedb.org' and 8880, which is a multiplexor for 1128all the other freedb servers. 1129 1130B<Utf8> is a boolean flag. If true, utf-8 will be used when submitting 1131CD info, and for interpreting the data reveived. This requires the 1132L<Encode> module (and probably perl version at least 5.8.0). The 1133default is true if the L<Encode> module can be loaded. Otherwise, it 1134will be false, meaning we fall back to ASCII. 1135 1136B<Protocol_Version> sets the cddbp version to use. CDDB.pm will not 1137connect to servers that don't support the version specified here. The 1138requested protocol version defaults to 1 if B<Utf8> is off, and to 6 1139if it is on. 1140 1141B<Login> is the login ID you want to advertise to the cddbp server. 1142It defaults to the login ID your computer assigns you, if that can be 1143determined. The default login ID is determined by the presence of a 1144LOGNAME or USER environment variable, or by the getpwuid() function. 1145On Windows systems, it defaults to "win32usr" if no default method can 1146be found and no Login parameter is set. 1147 1148B<Submit_Address> is the e-mail address where new disc submissions go. 1149This defaults to 'freedb-submit@freedb.org'. Note, that testing 1150submissions should be done via C<test-submit@freedb.org>. 1151 1152B<Client_Name> and B<Client_Version> describe the client software used 1153to connect to the cddbp server. They default to 'CDDB.pm' and 1154CDDB.pm's version number. If developers change this, please consult 1155freedb's web site for a list of client names already in use. 1156 1157B<Debug> enables verbose operational information on STDERR when set to 1158true. It's normally not needed, but it can help explain why a program 1159is failing. If someone finds a reproduceable bug, the Debug output 1160and a test program would be a big help towards having it fixed. In 1161case of submission, if this flag is on, a copy of the submission 1162e-mail will be sent to the I<From> address. 1163 1164=item get_genres 1165 1166Takes no parameters. Returns a list of genres known by the cddbp 1167server, or undef if there is a problem retrieving them. 1168 1169=item calculate_id TOC 1170 1171The cddb protocol defines an ID as a hash of track lengths and the 1172number of tracks, with an added checksum. The most basic information 1173required to calculate this is the CD table of contents (the CD-i track 1174offsets, in "MSF" [Minutes, Seconds, Frames] format). 1175 1176Note however that there is no standard way to acquire this information 1177from a CD-ROM device. Therefore this module does not try to read the 1178TOC itself. Instead, developers must combine CDDB.pm with a CD 1179library which works with their system. The AudioCD suite of modules 1180is recommended: it has system specific code for MacOS, Linux and 1181FreeBSD. CDDB.pm's author has used external programs like dagrab to 1182fetch the offsets. Actual CDs aren't always necessary: the author has 1183heard of people generating TOC information from mp3 file lengths. 1184 1185That said, see parse_cdinfo() for a routine to parse "cdinfo" output 1186into a table of contents list suitable for calculate_id(). 1187 1188calculate_id() accepts TOC information as a list of strings. Each 1189string contains four fields, separated by whitespace: 1190 1191offset 0: the track number 1192 1193Track numbers start with 1 and run sequentially through the number of 1194tracks on a disc. Note: data tracks count on hybrid audio/data CDs. 1195 1196CDDB.pm understands two special track numbers. Track 999 holds the 1197lead-out information, which is required by the cddb protocol. Track 11981000 holds information about errors which have occurred while 1199physically reading the disc. 1200 1201offset 1: the track start time, minutes field 1202 1203Tracks are often addressed on audio CDs using "MSF" offsets. This 1204stands for Minutes, Seconds, and Frames (fractions of a second). The 1205combination pinpoints the exact disc frame where a song starts. 1206 1207Field 1 contains the M part of MSF. It is ignored for error tracks, 1208but it still must contain a number. Zero is suggested. 1209 1210offset 2: the track start time, seconds field 1211 1212This field contains the S part of MSF. It is ignored for error 1213tracks, but it still must contain a number. Zero is suggested. 1214 1215offset 3: the track start time, frames field 1216 1217This field contains the F part of MSF. For error tracks, it contains 1218a description of the error. 1219 1220Example track file. Note: the comments should not appear in the file. 1221 1222 1 0 2 37 # track 1 starts at 00:02 and 37 frames 1223 2 1 38 17 # track 2 starts at 01:38 and 17 frames 1224 3 11 57 30 # track 3 starts at 11:57 and 30 frames 1225 ... 1226 999 75 16 5 # leadout starts at 75:16 and 5 frames 1227 1228Track 1000 should not be present if everything is okay: 1229 1230 1000 0 0 Error reading TOC: no disc in drive 1231 1232In scalar context, calculate_id() returns just the cddbp ID. In a 1233list context, it returns an array containing the following values: 1234 1235 ( 1236 $cddbp_id, 1237 $track_numbers, 1238 $track_lengths, 1239 $track_offsets, 1240 $total_seconds 1241 ) = $cddbp->calculate_id(@toc); 1242 1243 print( 1244 "cddbp ID = $cddbp_id\n", # b811a20c 1245 "track numbers = @$track_numbers\n", # 001 002 003 ... 1246 "track lengths = @$track_lengths\n", # 01:36 10:19 04:29 ... 1247 "track offsets = @$track_offsets\n", # 187 7367 53805 ... 1248 "total seconds = $total_seconds\n", # 4514 1249 ); 1250 1251CDDBP_ID 1252 1253The 0th returned value is the hashed cddbp ID, required for any 1254queries or submissions involving this disc. 1255 1256TRACK_NUMBERS 1257 1258The 1st returned value is a reference to a list of track numbers, one 1259for each track (excluding the lead-out), padded to three characters 1260with leading zeroes. These values are provided for convenience, but 1261they are not required by cddbp servers. 1262 1263TRACK_LENGTHS 1264 1265The 2nd returned value is a reference to a list of track lengths, one 1266for each track (excluding the lead-out), in HH:MM format. These 1267values are returned as a convenience. They are not required by cddbp 1268servers. 1269 1270TRACK_OFFSETS 1271 1272The 3rd returned value is a reference to a list of absolute track 1273offsets, in frames. They are calculated from the MSF values, and they 1274are required by get_discs() and submit_disc(). 1275 1276TOTAL_SECONDS 1277 1278The 4th and final value is the total playing time for the CD, in 1279seconds. The get_discs() function needs it. 1280 1281=item get_discs CDDBP_ID, TRACK_OFFSETS, TOTAL_SECONDS 1282 1283get_discs() asks the cddbp server for a summary of all the CDs 1284matching a given cddbp ID, track offsets, and total playing time. 1285These values can be retrieved from calculade_id(). 1286 1287 my @id_info = $cddbp->calculate_id(@toc); 1288 my $cddbp_id = $id_info->[0]; 1289 my $track_offsets = $id_info->[3]; 1290 my $total_seconds = $id_info->[4]; 1291 1292get_discs() returns an array of matching discs, each of which is 1293represented by an array reference. It returns an empty array if the 1294query succeeded but did not match, and it returns undef on error. 1295 1296 my @discs = $cddbp->get_discs( $cddbp_id, $track_offsets, $total_seconds ); 1297 foreach my $disc (@discs) { 1298 my ($disc_genre, $disc_id, $disc_title) = @$disc; 1299 print( 1300 "disc id = $disc_id\n", 1301 "disc genre = $disc_genre\n", 1302 "disc title = $disc_title\n", 1303 ); 1304 } 1305 1306DISC_GENRE is the genre this disc falls into, as determined by whoever 1307submitted or last edited the disc. The genre is required when 1308requesting a disc's details. See get_genres() for how to retrieve a 1309list of cddbp genres. 1310 1311CDDBP_ID is the cddbp ID of this disc. Cddbp servers perform fuzzy 1312matches, returning near misses as well as direct hits on a cddbp ID, 1313so knowing the exact ID for a disc is important when submitting 1314changes or requesting a particular near-miss' details. 1315 1316DISC_TITLE is the disc's title, which may help a human to pick the 1317correct disc out of several close mathches. 1318 1319=item get_discs_by_toc TOC 1320 1321This function acts as a macro, combining calculate_id() and 1322get_discs() calls into one function. It takes the same parameters as 1323calculate_id(), and it returns the same information as get_discs(). 1324 1325=item get_discs_by_query QUERY_STRING 1326 1327Fetch discs by a pre-built cddbp query string. Some disc querying 1328programs report this string, and get_discs_by_query() is a convenient 1329way to use that. 1330 1331Cddb protocol query strings look like: 1332 1333 cddb query $cddbp_id $track_count @offsets $total_seconds 1334 1335=item get_disc_details DISC_GENRE, CDDBP_ID 1336 1337This function fetches a disc's detailed information from a cddbp 1338server. It takes two parameters: the DISC_GENRE and the CDDP_ID. 1339These parameters usually come from a call to get_discs(). 1340 1341The disc's details are returned in a reference to a fairly complex 1342hash. It includes information normally stored in comments. The most 1343common entries in this hash include: 1344 1345 $disc_details = get_disc_details( $disc_genre, $cddbp_id ); 1346 1347$disc_details->{"disc length"} 1348 1349The disc length is commonly stored in the form "### seconds", where 1350### is the disc's total playing time in seconds. It may hold other 1351time formats. 1352 1353$disc_details->{discid} 1354 1355This is a rehash (get it?) of the cddbp ID. It should match the 1356CDDBP_ID given to get_disc_details(). 1357 1358$disc_details->{dtitle} 1359 1360This is the disc's title. I do not know whether it will match the one 1361returned by get_discs(). 1362 1363$disc_details->{offsets} 1364 1365This is a reference to a list of absolute disc track offsets, similar 1366to the TRACK_OFFSETS returned by calculate_id(). 1367 1368$disc_details->{seconds} 1369 1370This is a reference to a list of track length, in seconds. 1371 1372$disc_details->{ttitles} 1373 1374This is a reference to a list of track titles. These are the droids 1375you are looking for. 1376 1377$disc_details->{"processed by"} 1378 1379This is a comment field identifying the name and version of the cddbp 1380server which accepted and entered the disc record into the database. 1381 1382$disc_details->{revision} 1383 1384This is the disc record's version number, used as a sanity check 1385(semaphore?) to prevent simultaneous revisions. Revisions start at 0 1386for new submissions and are incremented for every correction. It is 1387the responsibility of the submitter (be it a person or a program using 1388CDDB.pm) to provide a correct revision number. 1389 1390$disc_details->{"submitted via"} 1391 1392This is the name and version of the software that submitted this cddbp 1393record. The main intention is to identify records that are submitted 1394by broken software so they can be purged or corrected. 1395 1396$disc_details->{xmcd_record} 1397 1398The xmcd_record field contains a copy of the entire unprocessed cddbp 1399response that generated all the other fields. 1400 1401$disc_details->{genre} 1402 1403This is merely a copy of DISC_GENRE, since it's otherwise not possible 1404to determine it from the hash. 1405 1406=item parse_xmcd_file XMCD_FILE_CONTENTS, [GENRE] 1407 1408Parses an array ref of lines read from an XMCD file into the 1409disc_details hash described above. If the GENRE parameter is set it 1410will be included in disc_details. 1411 1412=item can_submit_disc 1413 1414Returns true or false, depending on whether CDDB.pm has enough 1415dependent modules to submit discs. If it returns false, you are 1416missing Mail::Internet, Mail::Header, or MIME::QuotedPrint. 1417 1418=item get_mail_address 1419 1420Returns what CDDB.pm thinks your e-mail address is, or what it was 1421last set to. It was added to fetch the default e-mail address so 1422users can see it and have an opportunity to correct it. 1423 1424 my $mail_from = $cddb->get_mail_address(); 1425 print "New e-mail address (or blank to keep <$mail_from>): "; 1426 my $new_mail_from = <STDIN>; 1427 $new_mail_from =~ s/^\s+//; 1428 $new_mail_from =~ s/\s+$//; 1429 $new_mail_from =~ s/\s+/ /g; 1430 $mail_from = $new_mail_from if length $new_mail_from; 1431 1432 $cddbp->submit_disc( 1433 ..., 1434 From => $mail_from, 1435 ); 1436 1437=item get_mail_host 1438 1439Returns what CDDB.pm thinks your SMTP host is, or what it was last set 1440to. It was added to fetch the default e-mail transfer host so users 1441can see it and have an opportunity to correct it. 1442 1443 my $mail_host = $cddb->get_mail_host(); 1444 print "New e-mail host (or blank to keep <$mail_host>): "; 1445 my $new_mail_host = <STDIN>; 1446 $new_mail_host =~ s/^\s+//; 1447 $new_mail_host =~ s/\s+$//; 1448 $new_mail_host =~ s/\s+/ /g; 1449 $mail_host = $new_mail_host if length $new_mail_host; 1450 1451 $cddbp->submit_disc( 1452 ..., 1453 Host => $mail_host, 1454 ); 1455 1456=item parse_cdinfo CDINFO_FILE 1457 1458Generates a table of contents suitable for calculate_id() based on the 1459output of a program called "cdinfo". CDINFO_FILE may either be a text 1460file, or it may be the cdinfo program itself. 1461 1462 my @toc = parse_cdinfo("cdinfo.txt"); # read cdinfo.txt 1463 my @toc = parse_cdinfo("cdinfo|"); # run cdinfo directly 1464 1465The table of contents can be passed directly to calculate_id(). 1466 1467=item submit_disc DISC_DETAILS 1468 1469submit_disc() submits a disc record to a cddbp server. Currently it 1470only uses e-mail, although it will try different ways to send that. 1471It returns true or false depending on whether it was able to send the 1472submission e-mail. 1473 1474The rest of CDDB.pm will work without the ability to submit discs. 1475While cddbp submissions are relatively rare, most CD collections will 1476have one or two discs not present in the system. Please submit new 1477discs to the system: the amazing number of existing discs got there 1478because others submitted them before you needed them. 1479 1480submit_disc() takes six required parameters and two optional ones. 1481The parameters are named, like hash elements, and can appear in any 1482order. 1483 1484Genre => DISC_GENRE 1485 1486This is the disc's genre. It must be one of the genres that the 1487server knows. See get_genres(). 1488 1489Id => CDDBP_ID 1490 1491This is the cddbp ID that identifies the disc. It should come from 1492calculate_id() if this is a new submission, or from get_disc_details() 1493if this is a revision. 1494 1495Artist => DISC_ARTIST 1496 1497This is the disc's artist, a freeform text field describing the party 1498responsible for the album. It will need to be entered from the disc's 1499notes for new submissions, or it can come from get_disc_details() on 1500subsequent revisions. 1501 1502DiscTitle => DISC_TITLE 1503 1504This is the disc's title, a freeform text field describing the album. 1505It must be entered from the disc's notes for new submissions. It can 1506come from get_disc_details() on subsequent revisions. 1507 1508Offsets => TRACK_OFFSETS 1509 1510This is a reference to an array of absolute track offsets, as provided 1511by calculate_id(). 1512 1513TrackTitles => TRACK_TITLES 1514 1515This is a reference to an array of track titles, either entered by a 1516human or provided by get_disc_details(). 1517 1518From => EMAIL_ADDRESS 1519 1520This is the disc submitter's e-mail address. It's not required, and 1521CDDB.pm will try to figure one out on its own if an address is 1522omitted. It may be more reliable to provide your own, however. 1523 1524The default return address may not be a deliverable one, especially if 1525CDDB.pm is being used on a dial-up machine that isn't running its own 1526MTA. If the current machine has its own MTA, problems still may occur 1527if the machine's Internet address changes. 1528 1529Host => SMTP_HOST 1530 1531This is the SMTP host to contact when sending mail. It's not 1532required, and CDDB.pm will try to figure one out on its own. It will 1533look at the SMTPHOSTS environment variable is not defined, it will try 1534'mail' and 'localhost' before finally failing. 1535 1536Revision => REVISION 1537 1538The revision number. Should be 1 for new submissions, and one higher 1539than the previous one for updates. The previous revision number is 1540available as the C<revision> field in the hash returned by 1541get_disc_details(). 1542 1543=back 1544 1545=head1 PRIVATE METHODS 1546 1547Documented as being not documented. 1548 1549=head1 EXAMPLES 1550 1551Please see the cddb.t program in the t (tests) directory. It 1552exercises every aspect of CDDB.pm, including submissions. 1553 1554=head1 COMPATIBILITY 1555 1556CDDB.pm uses standard Perl modules. It has been tested at one point 1557or another on OS/2, MacOS and FreeBSD systems, as well as the systems 1558listed at: 1559 1560 http://testers.cpan.org/search?request=dist&dist=CDDB 1561 1562If you want to submit disc information to the CDDB, you will need to 1563install two other modules: 1564 1565 Mail::Internet will allow CDDB.pm to send email submissions, and it 1566 automagically includes Mail::Header. 1567 1568 MIME::QuotedPrint will allow CDDB.pm to send non-ASCII text 1569 unscathed. Currently only ISO-8859-1 and ASCII are supported. 1570 1571All other features will work without these modules. 1572 1573=head1 KNOWN TEST FAILURES 1574 1575The last test in the "make test" suite will try to send a sample 1576submission to the CDDB if MailTools is present. It expects to find an 1577SMTP host in the SMTPHOST environment variable. It will fall back to 1578"mail" if SMTPHOST doesn't exist. If neither works, the test will be 1579skipped. To see why it's skipped: 1580 1581 make test TEST_VERBOSE=1 1582 1583Some of the tests (most notably numbers 25, 27 and 29) compare data 1584returned by a cddbp server against a stored copy of a previous query. 1585These tests fail occasionally since the database is constantly in 1586flux. Starting with version 1.00, the test program uses fuzzy 1587comparisons that should fail less. Version 1.04 saw even fuzzier 1588comparisons. Please report any problems so they can be fixed. 1589 1590=head1 LINKS 1591 1592=head2 BUG TRACKER 1593 1594https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=CDDB 1595 1596=head2 REPOSITORY 1597 1598http://github.com/rcaputo/cddb-perl 1599http://gitorious.org/cddb-freedb-perl 1600 1601=head2 OTHER RESOURCES 1602 1603http://search.cpan.org/dist/CDDB/ 1604 1605=head1 CONTACT AND COPYRIGHT 1606 1607Copyright 1998-2013 Rocco Caputo. All rights reserved. This program 1608is free software; you can redistribute it and/or modify it under the 1609same terms as Perl itself. 1610 1611=cut 1612 1613# vim: sw=2 tw=70: 1614