Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Get CDDB info on Win32

by PodMaster (Abbot)
on Jul 04, 2003 at 06:37 UTC ( #271411=snippet: print w/ replies, xml ) Need Help??

Description: 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();

Comment on Get CDDB info on Win32
Download Code
Re: Get CDDB info on Win32
by PodMaster (Abbot) on Jul 04, 2003 at 07:26 UTC
    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.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://271411]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2014-12-21 02:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (101 votes), past polls