| 1 | package Tracks; |
|---|
| 2 | |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | |
|---|
| 6 | use Class::Std; |
|---|
| 7 | use Digest::SHA1; |
|---|
| 8 | use Audio::FLAC::Header; |
|---|
| 9 | |
|---|
| 10 | use constant SECTOR_OFFSET => 150; |
|---|
| 11 | |
|---|
| 12 | my %tracks_for :ATTR( get => 'tracks' ); |
|---|
| 13 | |
|---|
| 14 | sub _get_tracks_from_cdinfo { |
|---|
| 15 | my $device = shift; |
|---|
| 16 | my @tracks; |
|---|
| 17 | open my $CD_INFO, 'cd-info -q |' or die "Unable to run cd-info: $!"; |
|---|
| 18 | while (<$CD_INFO>) { |
|---|
| 19 | next unless /^\s*([0-9]+): \d\d:\d\d:\d\d (\d{6})/; |
|---|
| 20 | my ($num, $sector) = ($1, $2); |
|---|
| 21 | my $track = { |
|---|
| 22 | number => $num, |
|---|
| 23 | sector => $sector, |
|---|
| 24 | }; |
|---|
| 25 | # place leadout track (170) at index 0 |
|---|
| 26 | $num != 170 ? $tracks[$num] = $track : $tracks[0] = $track; |
|---|
| 27 | } |
|---|
| 28 | close $CD_INFO; |
|---|
| 29 | |
|---|
| 30 | return @tracks; |
|---|
| 31 | } |
|---|
| 32 | |
|---|
| 33 | sub _get_tracks_from_cdparanoia { |
|---|
| 34 | my $device = shift; |
|---|
| 35 | my @tracks; |
|---|
| 36 | open my $CDP, 'cdparanoia -d ' . $device . ' -Q 2>&1 |' or die "Unable to run cdparanoia: $!"; |
|---|
| 37 | while (<$CDP>) { |
|---|
| 38 | if (m{ |
|---|
| 39 | ^\s+(\d+)\. # track number |
|---|
| 40 | \s+(\d+) # length |
|---|
| 41 | \s+\[(\d\d:\d\d\.\d\d)\] # length (MSF) |
|---|
| 42 | \s+(\d+) # start |
|---|
| 43 | \s+\[(\d\d:\d\d\.\d\d)\] # start (MSF) |
|---|
| 44 | }x) { |
|---|
| 45 | my ($track, $length, $length_msf, $start, $start_msf) = ($1, $2, $3, $4, $5); |
|---|
| 46 | $start_msf =~ s/\./:/; |
|---|
| 47 | $tracks[$track] = { |
|---|
| 48 | number => $track, |
|---|
| 49 | sector => $start, |
|---|
| 50 | msf => $start_msf, |
|---|
| 51 | }; |
|---|
| 52 | } elsif (m{TOTAL\s+(\d+)}) { |
|---|
| 53 | my $total = $1; |
|---|
| 54 | my $leadout = $total + $tracks[1]{sector}; |
|---|
| 55 | $tracks[0] = { |
|---|
| 56 | number => 170, |
|---|
| 57 | sector => $leadout, |
|---|
| 58 | }; |
|---|
| 59 | } |
|---|
| 60 | } |
|---|
| 61 | close $CDP; |
|---|
| 62 | |
|---|
| 63 | return @tracks; |
|---|
| 64 | } |
|---|
| 65 | |
|---|
| 66 | sub read_disc { |
|---|
| 67 | my ($self, $device) = @_; |
|---|
| 68 | $tracks_for{ident $self} = [ _get_tracks_from_cdparanoia($device) ]; |
|---|
| 69 | } |
|---|
| 70 | |
|---|
| 71 | sub get_mbz_discid { |
|---|
| 72 | my ($self) = @_; |
|---|
| 73 | |
|---|
| 74 | my @tracks = @{ $tracks_for{ident $self} }; |
|---|
| 75 | |
|---|
| 76 | return unless @tracks; |
|---|
| 77 | |
|---|
| 78 | my $sha1 = Digest::SHA1->new; |
|---|
| 79 | |
|---|
| 80 | $sha1->add(sprintf('%02X', $tracks[1]{number})); |
|---|
| 81 | $sha1->add(sprintf('%02X', $tracks[-1]{number})); |
|---|
| 82 | for my $i (0 .. 99) { |
|---|
| 83 | my $offset = (defined $tracks[$i]{sector} ? ($tracks[$i]{sector} + SECTOR_OFFSET) : 0); |
|---|
| 84 | $sha1->add(sprintf('%08X', $offset)); |
|---|
| 85 | } |
|---|
| 86 | |
|---|
| 87 | my $digest = $sha1->b64digest; |
|---|
| 88 | $digest =~ tr{+/=}{._-}; |
|---|
| 89 | $digest .= '-'; ## why do we need to manually add this? |
|---|
| 90 | |
|---|
| 91 | return $digest; |
|---|
| 92 | } |
|---|
| 93 | |
|---|
| 94 | |
|---|
| 95 | sub get_cuesheet { |
|---|
| 96 | my ($self) = @_; |
|---|
| 97 | my @tracks = @{ $tracks_for{ident $self} }; |
|---|
| 98 | my @cuesheet; |
|---|
| 99 | push @cuesheet, qq{FILE "cdda.wav" WAVE}; |
|---|
| 100 | for my $i (1 .. @tracks - 1) { |
|---|
| 101 | my $track = $tracks[$i]; |
|---|
| 102 | push @cuesheet, sprintf(' TRACK %02d AUDIO', $i); |
|---|
| 103 | if ($i == 1 && $track->{sector} != 0) { |
|---|
| 104 | push @cuesheet, ' INDEX 00 00:00:00'; |
|---|
| 105 | } |
|---|
| 106 | push @cuesheet, ' INDEX 01 ' . $track->{msf}; |
|---|
| 107 | } |
|---|
| 108 | return join('', map { "$_\n" } @cuesheet); |
|---|
| 109 | } |
|---|
| 110 | |
|---|
| 111 | sub get_cdparanoia_span { |
|---|
| 112 | my ($self) = @_; |
|---|
| 113 | # use a msf start unless track 1 begins at sector |
|---|
| 114 | return $tracks_for{ident $self}[1]{sector} == 0 ? '1-' : '00:00.00-'; |
|---|
| 115 | } |
|---|
| 116 | |
|---|
| 117 | # module return |
|---|
| 118 | 1; |
|---|