Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re: Music CD Data

by CountZero (Bishop)
on Jun 02, 2005 at 04:08 UTC ( #462740=note: print w/replies, xml ) Need Help??


in reply to Music CD Data

I looked in CPAN and to my surprise none of the CD catalogue-ing modules support Windows!

So I wrote a script myself that reads the data from the cd in your cd-drive and searches for it at the freedb.org database. Just put a CD in your drive and run this script. It wouldn't be too difficult to put the data it finds in your own database. SQLite seems a good candidate for such a thing.

use Win32::MCI::Basic; use CDDB; use strict; use POSIX; use Data::Dumper; my $debug=0; my @cd_infos=process_cd(); print Dumper(\@cd_infos) if $debug; unless (@cd_infos) { print "No record for this CD exists.\n"; exit; }; foreach (@cd_infos) { my $cd=$_; my ($disc_genre, $disc_title, $disc_author, @track_titles); print Dumper(\$cd) if $debug; $disc_genre = $cd->[1]; $disc_title = $cd->[2]; $disc_author = $cd->[3]; @track_titles = @{$cd->[4]}; print "This $disc_genre CD, called '$disc_title' by $disc_author, co +ntains the following tracks:\n\t", join "\n\t", @track_titles, "\n"; } sub process_cd { my @frames; $frames[0]=frames(mci_command("status cdaudio position track 1")); for (1 .. mci_command("status cdaudio number of tracks")) { push @frames, frames(mci_command("status cdaudio length track ". $ +_))+$frames[$_-1]; } ++$frames[$#frames]; #On windows, MCI reports the length of the last + track to be one frame short! my $cddbp_id = compute_discid (@frames); return undef unless $cddbp_id; print "$cddbp_id\n", join "\n", @frames if $debug; my $length=int((pop @frames)/75); print "\nlengte: $length seconds\n" if $debug; my $cddbp = new CDDB( Host => 'freedb.freedb.org', # default Port => 8880, # default Login => 'guest', Debug => $debug ) or die $!; my @discs = $cddbp->get_discs( $cddbp_id, \@frames, $length ); my @results; foreach my $disc (@discs) { my @result; my ($disc_genre, $disc_id, $disc_title) = @$disc; #gets basic info print( "disc id = $disc_id\n", "disc genre = $disc_genre\n", "disc title = $disc_title\n", ) if $debug; #now get detailed info my $disc_details = $cddbp->get_disc_details( $disc_genre, $cddbp_i +d ); print join "\n", @{$disc_details->{ttitles}} if $debug; my $author='unknown'; my $title=$disc_title; if ($disc_title=~m/ \/ /) { ($author, $title) = split / \/ /, $disc_title; } push @result, ($disc_id, $disc_genre, $title, $author, $disc_detai +ls->{ttitles}); push @results, \@result; } return @results; } sub mci_command { my $lpszCommand = shift; # example MCI command my ($APICallReturnValue, $lpszReturnString) = mciSendString($lpszCom +mand); #my $lpszErrorText = mciGetErrorString($ReturnValue); #print "Error: $lpszErrorText\n"; return $lpszReturnString; } sub frames { my ($minutes, $seconds, $frames) = split /:/, shift; return ($minutes * 60 + $seconds) *75 + $frames; } #!/usr/bin/perl # Usage: # # my $id = compute_discid (@frames); # # "@frames" is the start-position in frames of each track on the disc. # (A frame is 1/75th of a second.) # Returns the disc ID as a string. sub cddb_sum { # a number like 2344 becomes 2+3+4+4 (13). my ($n) = @_; my $ret = 0; while ($n > 0) { $ret += ($n % 10); $n /= 10; } return $ret; } sub compute_discid { my @frames = @_; my $tracks = $#frames + 1; my $n = 0; my @start_secs; my $i; for ($i = 0; $i < $tracks; $i++) { $start_secs[$i] = POSIX::floor ($frames[$i] / 75); } for ($i = 0; $i < $tracks-1; $i++) { $n = $n + cddb_sum ($start_secs[$i]); } my $t = $start_secs[$tracks-1] - $start_secs[0]; my $id = ((($n % 0xFF) << 24) | ($t << 8) | $tracks-1); return sprintf ("%08x", $id); }

CountZero

"If you have four groups working on a compiler, you'll get a 4-pass compiler." - Conway's Law

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (2)
As of 2023-01-31 03:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?