Get CDDB info on Win32

[PodMaster]

CDDB doesn't know how to retrieve the cdid and track offsets on win32. Net::FreeDB does, but it's query methods are broken. Combine the two and you can successfully query freedb.org.

PS: please don't respond asking me to disscuss how Net::FreeDB is broken.

use Net::FreeDB;
use CDDB;
use Data::Dumper;
use strict;
use warnings;

{
    my $freedb = Net::FreeDB->new();
    my $discdata = $freedb->getdiscdata(0);

### Connect to the cddbp server.
    my $cddbp = CDDB->new(
        Host  => 'freedb.freedb.org', # default
        Port  => 8880,                # default
        Login => 'zappa',           # defaults to %ENV's
        Debug => 0,
    ) or die $!;

### Query discs based on cddbp ID and other information.

    my( $cddbp_id, $track_offsets, $total_seconds ) = (
        $discdata->{ID},
        $discdata->{TRACKS},
        $discdata->{SECONDS}
    );

    for my $disc ( $cddbp->get_discs($cddbp_id, $track_offsets, $total
+_seconds ) ) {
        my ($genre, $cddbp_id, $title) = @$disc;
### Query disc details (usually done with get_discs() information).
        my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id);
        print $/, Dumper($disc_info), $/;
    }
}

exit();

[PodMaster]

I finally worked out how to get the neccessary cd ID info using Win32::MCI::CD. Enjoy.

#!/usr/bin/perl -w -- 
use strict;
use Data::Dumper;
use CDDB;

my $cd = MyCDROM->new(
    -aliasname => 'our_cd',
    -drive     => shift,
) or die "EEEK: $!";

if ( $cd->cd_opendevice() ) {

### Connect to the cddbp server.
    my $cddbp = CDDB->new( Login => 'zappa' ) or die $!;

### Query discs based on cddbp ID and other information.

    for my $disc ( $cddbp->get_discs( $cd->disc_id() ) ) {
        my ($genre, $cddbp_id, $title) = @$disc;
### Query disc details (usually done with get_discs() information).
        my $disc_info = $cddbp->get_disc_details($genre, $cddbp_id);
        print $/, Dumper($disc_info), $/;
    }

}

$cd->cd_closedevice();    # for 1..4; # can't forget this

package MyCDROM;

#adapted from CDDB.py from
#http://cddb-py.sourceforge.net/CDDB/README
# with help from
# http://www.freedb.org/modules.php?name=Sections&sop=viewarticle&arti
+d=27
# http://www.vbaccelerator.com/home/VB/Code/vbMedia/CD_TrackListings/a
+rticle.asp

use base qw[ Win32::MCI::CD ];
use integer;
use strict;

sub cd_mode_msf {
    my $cd  = shift;
    my $grr = $cd->{ -aliasname };

    $grr = "set $grr time format msf";

    return ( Win32::MCI::CD::sendstring($grr) )[0];
}

sub toc_header {
    my $cd = shift;
    return 1, $cd->cd_tracks;
}


sub toc_entry {
    my ( $cd, $track ) = @_;

    my $grr = $cd->{-aliasname};

    $cd->cd_mode_msf();
    $grr = "status $grr position track $track";

    my ( $r, $s ) = Win32::MCI::CD::sendstring($grr);

    return if $r != 0;
    return split /\:/, $s;
}

sub toc_entry_pos {
    my ( $cd, $track ) = @_;
    return $cd->toc_entry($track);
}

sub toc_entry_len {
    my ( $cd, $track ) = @_;
    $cd->cd_mode_msf();
    my $ret = $cd->cd_tracklength($track);
    return unless $ret;
    return split /\:/, $ret;
}

#warn "last_error => ", $cd->cd_getlasterror();
sub leadout {
    my $cd = shift;
    my ( $firstTrack, $lastTrack ) = $cd->toc_header();
    my ( $trackPosMin, $trackPosSecond, $trackPosFrame ) =
      $cd->toc_entry_pos($lastTrack);
    my ( $trackLenMin, $trackLenSecond, $trackLenFrame ) =
      $cd->toc_entry_len($lastTrack);

    # calculate raw leadout
    my ( $leadoutMin, $leadoutSecond, $leadoutFrame ) = (
        $trackPosMin + $trackLenMin,
        $trackPosSecond + $trackLenSecond,
        $trackPosFrame + $trackLenFrame
    );

    # add windows specific correction
    $leadoutFrame = $leadoutFrame + $leadoutFrame;

    # convert to minute, second, frame
    if ( $leadoutFrame >= 75 ) {
        $leadoutFrame  = $leadoutFrame - 75;
        $leadoutSecond = $leadoutSecond + 1;
    }

    if ( $leadoutSecond >= 60 ) {
        $leadoutSecond = $leadoutSecond - 60;
        $leadoutMin    = $leadoutMin + 1;
    }

    return $leadoutMin, $leadoutSecond, $leadoutFrame;
}

# a number like 2344 becomes 2+3+4+4 (13).
sub cddb_sum {
    my $n   = shift;
    my $ret = 0;

    while ( $n > 0 ) {
        $ret = $ret + ( $n % 10 );
        $n = ( $n / 10 );
    }

    return $ret;
}

sub disc_id {
    my $cd = shift;
    my ( $first, $last ) = $cd->toc_header();

    my @track_frames;
    my $checksum = 0;

    for my $i ( $first .. $last ) {
        my ( $min, $sec, $frame ) = $cd->toc_entry($i);

        $checksum = $checksum + cddb_sum(  $min * 60 + $sec  );
        push @track_frames, ( $min * 60 * 75 + $sec * 75 + $frame );
    }

    my ( $min, $sec, $frame ) = $cd->leadout();
    my $leadout = ( $min * 60 * 75 + $sec * 75 + $frame );

    my $total_time = ( $leadout / 75 ) - ( $track_frames[0] / 75 );

    my $discid = sprintf '%08x',
        ( ( $checksum % 0xff ) << 24 | $total_time << 8 | $last );

    return $discid, \@track_frames, ( $leadout / 75 ),;
}

MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"

I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).

** The third rule of perl club is a statement of fact: pod is sexy.