Re: Re: Audio CD covers

[PodMaster]

Here ya go (with the help of Get CDDB info on Win32), although I gotta say it doesn't look too good.

#!/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;

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.