Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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.


In reply to Re: Re: Audio CD covers by PodMaster
in thread Audio CD covers by larsen

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others taking refuge in the Monastery: (6)
    As of 2017-12-16 00:55 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What programming language do you hate the most?




















      Results (447 votes). Check out past polls.

      Notices?