[1] | 1 | #!/usr/bin/perl -w |
---|
| 2 | use strict; |
---|
| 3 | |
---|
| 4 | package Tracks; |
---|
| 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 | package main; |
---|
| 118 | use File::Temp qw{tempdir}; |
---|
| 119 | use File::Spec::Functions qw{catfile splitpath}; |
---|
| 120 | use File::Copy; |
---|
| 121 | use File::Path qw{mkpath}; |
---|
| 122 | use Getopt::Long qw{:config no_ignore_case no_auto_abbrev}; |
---|
| 123 | use Cwd; |
---|
| 124 | |
---|
| 125 | GetOptions( |
---|
| 126 | 'device|D=s' => \my $CD_DEVICE, |
---|
| 127 | 'output|o=s' => \my $OUTPUT_NAME, |
---|
| 128 | 'force|f' => \my $FORCE, |
---|
| 129 | ); |
---|
| 130 | |
---|
| 131 | # output file |
---|
| 132 | my (undef, $out_dir, $out_file) = splitpath($OUTPUT_NAME); |
---|
| 133 | # automatically add ".flac" |
---|
| 134 | $out_file .= '.flac' unless $out_file =~ /\.flac$/; |
---|
| 135 | # default to current directory |
---|
| 136 | $out_dir ||= getcwd; |
---|
| 137 | mkpath($out_dir) unless -e $out_dir; |
---|
| 138 | my $archive_flac = catfile($out_dir, $out_file); |
---|
| 139 | |
---|
| 140 | # check for file exist; default to not overwrite |
---|
| 141 | die "$archive_flac exists\nwill not overwrite (use --force to override this)\n" |
---|
| 142 | if -e $archive_flac && !$FORCE; |
---|
| 143 | |
---|
| 144 | # get the CD info |
---|
| 145 | $CD_DEVICE ||= '/dev/cdrom'; |
---|
| 146 | my $tracks = Tracks->new; |
---|
| 147 | $tracks->read_disc($CD_DEVICE); |
---|
| 148 | |
---|
| 149 | die "No tracks found; is there a CD in the drive?\n" unless @{ $tracks->get_tracks }; |
---|
| 150 | |
---|
| 151 | my $tempdir = tempdir(CLEANUP => 1); |
---|
| 152 | |
---|
| 153 | my $wav_file = catfile($tempdir, 'cdda.wav'); |
---|
| 154 | my $flac_file = catfile($tempdir, 'cdda.flac'); |
---|
| 155 | my $cue_file = catfile($tempdir, 'cdda.cue'); |
---|
| 156 | |
---|
| 157 | # rip |
---|
| 158 | my $span = $tracks->get_cdparanoia_span; |
---|
| 159 | system 'cdparanoia', '-d', $CD_DEVICE, $span, $wav_file; |
---|
| 160 | die "\nRipping canceled\n" if ($? & 127); |
---|
| 161 | |
---|
| 162 | |
---|
| 163 | # encode + cuesheet |
---|
| 164 | open my $CUE, "> $cue_file"; |
---|
| 165 | print $CUE $tracks->get_cuesheet; |
---|
| 166 | close $CUE; |
---|
| 167 | system 'flac', '-o', $flac_file, '--cuesheet', $cue_file, $wav_file; |
---|
| 168 | die "\nFLAC encoding canceled\n" if ($? & 127); |
---|
| 169 | |
---|
| 170 | # MusicBrainz discid metadata |
---|
| 171 | my $discid = $tracks->get_mbz_discid; |
---|
| 172 | |
---|
| 173 | # copy to permanent location |
---|
| 174 | copy($flac_file, $archive_flac); |
---|
| 175 | system 'metaflac', '--set-tag', "MBZ_DISCID=$discid", $archive_flac; |
---|
| 176 | print "Rip saved as $archive_flac\n"; |
---|
| 177 | system 'eject', $CD_DEVICE; |
---|