#!/usr/bin/perl
# cddb_cover.pl - 17/9/2001
# by Stefano Rodighiero
# http://larsen.perlmonk.org
# adapted by PodMaster for Win32
use strict;
#use MyCDROM;
my %cd;
{
my($cd) = MyCDROM->GetTheDiscDetails('D:');
@cd{qw[ artist title ]} = split /\s\/\s/, $cd->{'dtitle'}, 2;
$cd{tno} = @{ $cd->{ttitles} };
$cd{track} = $cd->{ttitles};
}
use PDF::Create;
# A4 are 210x297 mm
use constant A4_WIDTH => 612;
use constant A4_HEIGHT => 792;
use constant A4_BOX => [0, 0, 612, 792];
# A CD cover is 12cm side...
use constant CD_WIDTH => 350;
my %font_size = (
Small => 10,
Medium => 15,
Large => 20,
);
my $pdf = new PDF::Create(
filename => $ARGV[0] || 'cover.pdf',
Version => 1.2,
PageMode => 'UseNone',
Author => '',
Creator => '',
Title => 'Copertina'
);
my $root = $pdf->new_page(
Mediabox => [ A4_BOX ]
);
my $font = $pdf->font(
Subtype => 'Type1',
Encoding => 'WinAnsiEncoding',
BaseFont => 'Helvetica'
);
my $page = $root->new_page;
my $cover = {
# Where front has to be put on the page?
front_corner_x => 100,
front_corner_y => 10,
# The same for the back
back_corner_x => 100,
back_corner_y => 10 + CD_WIDTH + 10,
};
draw_front( $page, \%cd );
draw_back( $page, \%cd );
$pdf->close;
sub draw_front
{
my $page = shift;
my $cd = shift;
draw_CD_box( $page, $cover->{ 'front_corner_x' }, $cover->{ 'front_c
+orner_y' }, "Front" );
$page->string(
$font, $font_size{'Medium'},
$cover->{'front_corner_x'} + 5,
$cover->{'front_corner_y'} + CD_WIDTH - $font_size{'Medium'},
$cd->{'artist'} );
# print "$cd->{'artist'}\n";
$page->string(
$font, $font_size{'Large'},
$cover->{'front_corner_x'} + 5,
$cover->{'front_corner_y'} + CD_WIDTH - 5 - $font_size{'Medium'} -
+$font_size{'Large'},
$cd->{'title'} );
# print "$cd->{'title'}\n";
}
sub draw_back
{
my $page = shift;
my $cd = shift;
draw_CD_box( $page, $cover->{ 'back_corner_x' }, $cover->{ 'back_cor
+ner_y' }, "Back" );
my $initial_pos = $cover->{'back_corner_y'} + ($font_size{'Small'} *
+ $cd->{'tno'});
my $counter = 1;
foreach my $title ( @{ $cd->{'track'}} ) {
$page->string(
$font, $font_size{'Small'},
$cover->{'back_corner_x'} + 5, $initial_pos - $font_size{'Small'}
+ * ($counter - 1),
"$counter. " . $title );
++$counter;
# print "$counter. $title\n";
}
}
# Draw CD bounding box
sub draw_CD_box
{
my $page = shift;
my ($corner_x, $corner_y, $str) = @_;
my @corner = (
[$corner_x, $corner_y],
[$corner_x + CD_WIDTH, $corner_y],
[$corner_x + CD_WIDTH, $corner_y + CD_WIDTH],
[$corner_x, $corner_y + CD_WIDTH],
[$corner_x, $corner_y] # yes, it's the first repeated. see below
);
foreach( 0..3 ) {
$page->line( @{$corner[$_]}, @{$corner[$_+1]} );
}
# Put a string near the right-upper corner
if ( $str ) {
$page->string(
$font, $font_size{'Small'},
$corner_x + CD_WIDTH + 5, $corner_y + CD_WIDTH - $font_size{'Smal
+l'},
$str );
}
}
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;
}
# this is failing somehow
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);
}
# this is failing
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();
=head2 leadout
my( $min, $sec, $frame ) = $cd->leadout();
=cut
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 $DONT_pack = shift || 0;
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 = ( ( $checksum % 0xff ) << 24 | $total_time << 8 | $la
+st );
$discid = sprintf '%08x', $discid if $DONT_pack; # for CDDB_get
return $discid, \@track_frames, ( $leadout / 75 ),;
}
=head2 GetTheDiscDetails
MyCDROM->GetTheDiscDetails('D:'); #default drive is D:
Dies on error, on success returns a list of
hashrefs ( each is one like returned from C<CDDB-E<gt>get_disc_details
+>)
=cut
sub GetTheDiscDetails {
require CDDB;
my( $self , $drive ) = @_;
$drive ||= 'D:';
my $cd = MyCDROM->new(
-aliasname => 'our_cd',
-drive => $drive,
) or die "ERROR -> MyCDROM -> $!";
if ( $cd->cd_opendevice() ) {
my @id = $cd->disc_id(0);
$cd->cd_closedevice();
### Connect to the cddbp server.
my $cddbp = CDDB->new( Login => 'zappa' ) or die $!;
### Query discs based on cddbp ID and other information.
my @discs;
for my $disc ( $cddbp->get_discs( @id ) ) {
my ($genre, $cddbp_id, $title) = @$disc;
### Query disc details (usually done with get_discs() information)
+.
push @discs, $cddbp->get_disc_details($genre, $cddbp_id);
}
return @discs;
} else {
warn "ERROR ". $cd->cd_getlasterror();
$cd->cd_closedevice();
die "cannot continue";
}
}
1;