#!/usr/bin/perl -w use strict; # extract one or more tracks from a FLAC file using its embedded cuesheet # save those tracks as wav or mp3 files # can also run them through a sox filter # TODO: separate sox filter for each track! use FindBin; use lib "$FindBin::RealBin/lib"; use Getopt::Long qw{:config no_ignore_case}; use File::Spec::Functions qw{catfile splitpath}; use File::Path; use Audio::FLAC::Header; use MusicBrainz; use Text::Unidecode; use Cwd; # default to using tags my $TAGS = 1; GetOptions( 'D=s' => \my %TRACKS, 't=s' => \my $TYPE, 'x=s' => \my $SOX_FILTER, 'all|a' => \my $ALL, 'dir|d=s' => \my $DIRECTORY, 'ascii-tags' => \my $ASCII_TAGS, 'tags!' => \$TAGS, 'force' => \my $FORCE, ); my $FLAC_FILE = shift or die "Need a flac file to decode"; # default to mp3 $TYPE ||= 'mp3'; # default to the current directory $DIRECTORY ||= cwd; my $flac = Audio::FLAC::Header->new($FLAC_FILE) or die "Can't read FLAC header from $FLAC_FILE\n"; # for getting track metadata from MusicBrainz my $info; if ($ALL || ($TYPE eq 'mp3' && $TAGS)) { (my $properties_file = $FLAC_FILE) =~ s/\.flac$/.properties/; if (-e $properties_file) { require Config::Properties; # the properties are in UTF-8; mark them as such so unidecode works correctly later my $properties = Config::Properties->new(file => $properties_file, encoding => 'utf8'); $info = $properties->getProperties; } else { my $discid = $flac->tags('MUSICBRAINZ_DISCID') or warn "No MUSICBRAINZ_DISCID tag in $FLAC_FILE\n" if $flac; #TODO: calculate TOC and DISCID from cuesheet if there is no MUSICBRAINZ_DISCID tag present $info = get_musicbrainz_info($discid); } exit unless $info; } if ($ALL) { # if we are converting an entire album file, create a directory to hold the mp3s # name the directory ARTIST.DATE.ALBUM, so it will sort nicely my $base_dir = $DIRECTORY; my $album_dir = join('.', map { to_filename($_) } @{$info}{qw{ALBUMARTISTSORT ORIGINALDATE ALBUM}}); # need to append "disc#" if this is a multidisc album if ($info->{DISCTOTAL} > 1) { $album_dir .= '.disc_' . $info->{DISCNUMBER}; } $DIRECTORY = catfile($base_dir, $album_dir); if (-e $DIRECTORY and not $FORCE) { die "$DIRECTORY already exists, skipping. (Use --force to overwrite)\n"; } #die $DIRECTORY; } if ($ALL) { die "Use of --all requires a --directory\n" unless $DIRECTORY; die "No track info found on MusicBrainz for $FLAC_FILE\n" unless $info; use YAML; my $cuesheet = $flac->cuesheet; my $count = scalar grep { /TRACK \d\d/ } @{ $flac->cuesheet }; print "Found $count tracks\n"; #TODO: default to just 01, 02, etc. if there is no $info %TRACKS = map { $_ => catfile($DIRECTORY, sprintf('%02d.%s', $_, to_filename($info->{sprintf 'TRACK%02d.TITLE', $_}))) } (1 .. $count); #print Dump(\%TRACKS); for my $tracknum (sort { $a <=> $b } keys %TRACKS) { printf "%2d: %s\n", $tracknum, $TRACKS{$tracknum}; } mkpath($DIRECTORY); } #TODO: all the option of sorting by tracknum or not #while (my ($tracknum, $title) = each %TRACKS) { for my $tracknum (sort { $a <=> $b } keys %TRACKS) { if ($tracknum !~ /^\d+$/) { warn "Don't know what to do with track number '$tracknum'"; next; } my $start = $tracknum . '.1'; my $end = $tracknum + 1 . '.1'; my $cmd = qq{flac -d --cue $start-$end $FLAC_FILE -o - }; if ($SOX_FILTER) { $cmd .= qq{| sox -t wav - -t wav - $SOX_FILTER }; } my $title = quotemeta($TRACKS{$tracknum}); if ($TYPE eq 'mp3') { # bitrate of 192 $cmd .= qq{| lame -b 192}; # if there is track info, add it as ID3 tags if ($info) { my $track_key = sprintf 'TRACK%02d', $tracknum; $cmd .= sprintf q{ --tt %s --ta %s --tl %s --ty %d --tn %d}, quote($ASCII_TAGS ? unidecode($info->{"$track_key.TITLE"}) : $info->{"$track_key.TITLE"}), quote($ASCII_TAGS ? unidecode($info->{"$track_key.ARTIST"}) : $info->{"$track_key.ARTIST"}), quote($ASCII_TAGS ? unidecode($info->{ALBUM}) : $info->{ALBUM}), ($info->{ORIGINALDATE} =~ /^(\d\d\d\d)/)[0], $tracknum; } $cmd .= qq{ - $title.mp3}; } elsif ($TYPE eq 'wav') { $cmd .= qq{> $title.wav}; } else { die "Unknown type: $TYPE\n"; } #die $cmd; system $cmd; die "\nFLAC decoding canceled\n" if ($? & 127); print "\n" if $SOX_FILTER; } sub quote { my ($string) = @_; $string =~ s/"/\\"/g; return qq{"$string"}; } sub to_filename { my @strings = @_; return map { s/&/ and /g; unidecode($_); s/[^a-z0-9-_ ]+//gi; s/ +/_/g; lc; } @strings; }