fix tests after shortening CD filenames

[flac-archive] / flacsplit

#! /usr/bin/env perl

use strict;
use warnings;

use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use POSIX ':sys_wait_h';
use Pod::Usage;

my $quiet;
my $verbose;

sub verbose {
    $verbose and print(STDERR $_) for @_;
}

sub run_or_die {
    my $command = shift;
    my $status;

    $verbose and print(STDERR "$command\n");
    $status = system($command);

    if (WIFEXITED($status)) {
        if (($status = WEXITSTATUS($status)) != 0) {
            die("$command exited with status $status");
        }
    } elsif (WIFSIGNALED($status)) {
        die("$command killed with signal ", WTERMSIG($status));
    } elsif (WIFSTOPPED($status)) {
        die("$command stopped with signal ", WSTOPSIG($status));
    } else {
        die("Major horkage on system($command): \$? = $? \$! = $!");
    }
}

sub tformat {
    return sprintf('%02d:%02d.%02d', @_);
}

sub get_decode_args {
    my $fn = shift;
    my @l;

    open(F, '-|', 'metaflac', '--no-utf8-convert', '--export-cuesheet-to=-',
         $fn);
    while (<F>) {
        /INDEX 01 (\d\d):(\d\d):(\d\d)$/ or next;
        push(@l, [$1, $2, $3]);
    }

    my @args;
    for my $i (0..$#l) {
        my $arg = ["--skip=" . tformat(@{$l[$i]})];
        my $next = $l[$i+1];
        if (defined($next)) {
            if ($next->[2] == 0) {
                if ($next->[1] == 0) {
                    push(@$arg, '--until=' . tformat($next->[0] - 1, 59, 74));
                } else {
                    push(@$arg, '--until=' . tformat($next->[0], $next->[1] - 1,
                                                    74));
                }
            } else {
                push(@$arg, '--until=' . tformat($next->[0], $next->[1],
                                                $next->[2] - 1));
            }
        }
        push(@args, $arg);
    }

    if (@args == 0) {
        die('no cue sheet');
    }

    return @args;
}

# Return the ARTIST, ALBUM, and DISCNUMBER followed by a list of all
# the lines in the file FN.
sub get_tags {
    my $fp = shift;
    my $fn = shift;
    my $tag;
    my $value;
    my $artist;
    my $album;
    my $discnum;
    my @tags;

    while (<$fp>) {
        chomp;
        push(@tags, $_);

        ($tag, $value) = split(/=/, $_, 2);

        if (/^ARTIST=/i) {
            $artist = $value;
            verbose("ARTIST $artist from $fn\n");
        } elsif (/^ALBUM=/i) {
            $album = $value;
            verbose("ALBUM $album from $fn\n"); # cperl-mode sucks "
        } elsif (/^DISCNUMBER=/i) {
            $discnum = int($value);
            verbose("DISCNUMBER $discnum from $fn\n");
        }
    }

    return ($artist, $album, $discnum, @tags);
}

sub track_tags {
    my $h = shift;
    my @result;

    while (my ($key, $vall) = each(%$h)) {
        for my $val (@$vall) {
            push(@result, "$key=$val")
        }
    }

    return @result;
}

sub flacsplit {
    my $fn = shift;
    my $artist;
    my $album;
    my $discnum;
    my @tags;
    my $outdir;

    open(my $fp, '-|', 'metaflac', '--no-utf8-convert', '--export-tags-to=-',
         $fn)
      or die("open(metaflac --no-utf8-convert --export-tags-to=- $fn): $!");
    ($artist, $album, $discnum, @tags) = get_tags($fp, $fn);
    close($fp)
        or die("close(metaflac --no-utf8-convert --export-tags-to=- $fn): $?");
    for ($artist, $album) {
        s|/|_|g;
    }

    -d $artist or mkdir($artist) or die("mkdir($artist): $!");
    $outdir = "$artist/$album";
    -d "$outdir" or mkdir("$outdir") or die("mkdir($outdir): $!");

    # Go over @tags, store all [n] tags in a list keyed by n in
    # %tracks_to_tags, store all ARTIST (not ARTIST[n]) tags in
    # @disc_artist, and leave the rest in @tags.
    my %tracks_to_tags;
    my @disc_artist;
    my @tmp;
    my $hack = 1;
    for my $tag (@tags) {
        if ($tag =~ /^([^[]+)\[(\d+)]=(.*)/) {
            push(@{$tracks_to_tags{$2}->{$1}}, $3);
        } elsif ($tag =~ /^TITLE=(.*)/) {
            push(@{$tracks_to_tags{$hack++}->{'TITLE'}}, $1);
        } elsif ($tag =~ /^ARTIST=/) {
            push(@disc_artist, $tag);
        } else {
            push(@tmp, $tag);
        }
    }
    @tags = @tmp;

    $fn =~ s/'/'\\''/g;

    for my $tracknum (sort(map(int, keys(%tracks_to_tags)))) {
        my $title = join(' ', map(split, @{$tracks_to_tags{$tracknum}->{'TITLE'}}));
        my $outfile = join(' ',
                           (defined($discnum)
                            ? sprintf('%02d', $discnum)
                            : ()),
                           sprintf('%02d', $tracknum),
                           $title);
        $outfile =~ s|/|_|g;
        $outfile = "$outdir/$outfile";
        $outfile =~ s/'/'\\''/g;

        # If we have ARTIST[n] tags for this track, set @track_artist
        # to the empty list; they will go in along with the other [n]
        # tags.
        my @track_artist;
        if (exists($tracks_to_tags{$tracknum}->{'ARTIST'})) {
            @track_artist = ();
        } else {
            @track_artist = @disc_artist;
        }

        my $flac_options = '';
        my ($skip_arg, $until_arg) = @{$_[$tracknum - 1]};
        $skip_arg ||= '';
        $until_arg ||= '';
        run_or_die(join(' ',
                        "flac $flac_options -cd $skip_arg $until_arg '$fn'",
                        " | flac -o '$outfile.flac' -V --no-padding --best",
                        map({ my $tag = "$_"; $tag =~ s/'/'\\''/g; ('-T', "'$tag'") }
                            @track_artist,
                            @tags,
                            "TRACKNUMBER=$tracknum",
                            track_tags($tracks_to_tags{$tracknum})),
                        '-'));
    }

    return 0;
}

MAIN: {
    my $help;
    GetOptions(
               'quiet|q' => \$quiet,
               'verbose|v' => \$verbose,
               'help|h|?' => \$help,
              ) or pod2usage();
    $help and pod2usage(-exitstatus=>0, -verbose=>1);

    @ARGV or pod2usage();
    for my $fn (@ARGV) {
        my @args = get_decode_args($fn);
        flacsplit($fn, @args);
    }
}