#!/usr/pkg/bin/perl
#
#   mkcdtoc - create cdrdao TOC file from list of audio files
#   (C) 2006 Konstantin Korikov <lostclus@ua.fm>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
#   02111-1307, USA.
#

=head1 NAME

mkcdtoc - create cdrdao TOC file from list of audio files

=head1 SYNOPSIS

B<mkcdtoc> [I<options>] [I<-->] [I<infile>]

=head1 DESCRIPTION

mkcdtoc reads a list of audio files and builds corresponding TOC file for
cdrdao.  The list is read from I<infile> or stdin, it can be an M3U play list
or simple raw list with one file name on each line. The resulting TOC file will
be output to stdout or to file specified by B<-o> option.

mkcdtoc has a modular architecture and can be extended via plugins. Plugins can
be used to fill CD-TEXT blocks with information given from audio files and to
perform audio file to WAVE format conversion.

When reading input from I<infile> the input data type can be determined by file
name extension, in this case appropriate input plugin will be loaded.  If file
name extension is not known by mkcdtoc or input is read from stdin then input
data is treated as raw list and input-raw plugin will be loaded. In any case
user can force mkcdtoc to use different input plugin by providing B<-plugin>
option with preferred plugin name.

=cut

use File::Basename;
use File::Spec::Functions;
use Encode;
use I18N::Langinfo qw(langinfo CODESET);

my $bugsto = 'lostclus@ua.fm';
my $usage = <<EOF;
Usage: mkcdtoc [-o outfile] [-country CC -owner OOO -year YY -serial number]
               [-copy|-no-copy] [-pre-emphasis|-no-pre-emphasis]
	       [-channels number] [-cdtext|-no-cdtext]
               [-langs list] [-disc-id id] [-disc-id-LANG id]
               [-title string] [-title-LANG string]
	       [-performer string] [-performer-LANG string]
	       [-songwriter string] [-songwriter-LANG string]
	       [-arranger string] [-arranger-LANG string]
	       [-message string] [-message-LANG string]
               [-inherit-title|-no-inherit-title]
               [-inherit-performer|-no-inherit-performer]
               [-inherit-songwriter|-no-inherit-songwriter]
               [-inherit-arranger|-no-inherit-arranger]
               [-inherit-message|-no-inherit-message]
               [-inherit-all|-no-inherit-all]
	       [-no-title] [-no-performer] [-no-songwriter]
	       [-no-arranger] [-no-message]
	       [-pregap MM:SS:FF ] [-path|-no-path]
               [-subst-ext extension|-append-ext extension|-no-change-ext]
	       [-plugin file[:opt1[=value1][,opt2[=value2]]...]]
               [--] [infile]
       mkcdtoc [-list-plugins|-plugin-info file]

Report bugs to: $bugsto
EOF

my $version = "1.0";
my $sysplugindir = "/usr/pkg/share/mkcdtoc/plugins";
my $usrplugindir = catdir($ENV{HOME}, '.mkcdtoc', 'plugins');
@glob_flags = qw(TITLE PERFORMER SONGWRITER COMPOSER
  ARRANGER MESSAGE DISC_ID UPC_EAN);
@track_flags = qw(TITLE PERFORMER SONGWRITER COMPOSER
  ARRANGER MESSAGE);
%plugin = ();
%plugin_purpose = ();
%plugin_options = ();
$input_plugin_hook = undef;
@info_plugin_hook = ();
$convert_plugin_hook = undef;

$SIG{__WARN__} = sub {
    printf STDERR "mkcdtoc: %s\n", $_[0];
};
$SIG{__DIE__} = sub {
    printf STDERR "mkcdtoc: %s\n", $_[0];
    exit 1;
};

sub quote {
    my $s = shift; $s =~ s/"/\\"/g; $s;
}

sub load_plugin {
    my $path = shift;
    my $opts = shift;
    my $file = basename($path);
    unless (exists $plugin{$file}) {
        if ($file eq $path) {
            for my $dir($usrplugindir, $sysplugindir) {
                if (-e catfile($dir, $file)) {
                    $path = catfile($dir, $file);
                    last;
                }
            }
        }
        $plugin{$file} = defined $opts ? $opts : {};
        require $path;
    } elsif (defined $opts) {
        $$plugin{$file}{$_} = $$opts{$_} for (keys(%$opts));
    }
}

sub track_info_ensure_defined {
    my ($ti, @flags) = @_;
    for my $fl(@flags) {
	$$ti{$fl} = [] unless defined $$ti{$fl};
    }
}

sub track_info_set_for_langs {
    my ($ti, $langs, %values) = @_;
    for my $fl(keys(%values)) {
	for my $nl(0..$#$langs) {
	    $ti->{$fl}->[$nl] = $values{$fl};
	}
    }
}

my $if = STDIN;
my $of = STDOUT;
$country = undef;
$owner = undef;
$year = undef;
$serial = undef;
$copy = 0;
$pre_emphasis = 0;
$channels = 2;
$cdtext = undef;
@langs = (9,);
%glob = ();
%inherit = map({($_=>1)} @track_flags);
%disable = ();
$pregap = undef;
$path = 0;
$subst_ext = '.wav';
$append_ext = undef;

sub process_glob_flag_opt {
    my ($fl, $lang, $arg) = @_;
    my $nl = 0;
    $nl++ while ($nl < @langs && $langs[$nl] ne uc($lang));
    $nl = 0 unless $nl < @langs;
    $glob{$fl} = [] unless exists $glob{$fl};
    $glob{$fl}[$nl] = $arg;
    $cdtext = 1;
}

sub parse_plugin_options {
    my $opts = {};
    for (split(',', $_[0])) {
	next if /^$/;
	if (/^(\w+)=(.*)$/) {
	    $$opts{$1} = $2;
	} else {
	    $$opts{$_} = 1;
	}
    }
    return $opts;
}

=head1 OPTIONS

=over

=cut

for (; @ARGV; shift @ARGV) {

=item B<-output> I<outfile> B<-o> I<outfile>

Send output to I<outfile>. Default is to send output to stdout.

=cut

    if ($ARGV[0] =~ /^-o(utput)?$/) {
	shift @ARGV;
	$of = $ARGV[0];
	die "cannot open $ARGV[0]: $!" unless open($of,
	    '>', $ARGV[0]);
    }

=item B<-country> I<CC>

Sets country code to use in ISRC flags.

=cut
    
    elsif ($ARGV[0] eq '-country') {
	shift @ARGV;
	$country = $ARGV[0];
	die "invalid country code format"
	  unless $country =~ /^[A-Z0-9]{2}$/;
    }
    
=item B<-owner> I<OOO>

Sets owner code to use in ISRC flags.

=cut
    
    elsif ($ARGV[0] eq '-owner') {
	shift @ARGV;
	$owner = $ARGV[0];
	die "invalid owner code format"
	  unless $owner =~ /^[A-Z0-9]{3}$/;
    }
    
=item B<-year> I<YY>

Sets year to use in ISRC flags.

=cut
    
    elsif ($ARGV[0] eq '-year') {
	shift @ARGV;
	$year = $ARGV[0];
	die "invalid year format"
	  unless $year =~ /^[0-9]{2}$/;
    }
    
=item B<-serial> I<number>

Sets starting serial number to use in ISRC flags.

=cut
    
    elsif ($ARGV[0] eq '-serial') {
	shift @ARGV;
	$serial = $ARGV[0];
	die "invalid serial number format"
	  unless $serial =~ /^[0-9]+$/;
    }

=item B<-copy> B<-no-copy>

Sets or clears the copy permitted flag for each track. By default the
copy permitted flag is not set.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?copy$/) {
	$copy = "$1" eq "";
    }
    
=item B<-pre-emphasis> B<-no-pre-emphasis>

Sets or clears the pre emphasis flag for each track. By default the
pre emphasis flag is not set.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?pre-emphasis$/) {
	$pre_emphasis = "$1" eq "";
    }

=item B<-channels> I<number>

Sets number of channels for each track. I<number> can be 2 or 4.
Default is 2 channels.

=cut
    
    elsif ($ARGV[0] eq '-channels') {
	shift @ARGV;
	$channels = $ARGV[0];
	die "invalid number of channels"
	  unless $channels =~ /^(2|4)$/;
    }

=item B<-cdtext> B<-no-cdtext>

Enable or disable generation of CD-TEXT blocks. Default is to
generate CD-TEXT blocks if meta information is available.

=cut

    elsif ($ARGV[0] =~ /^-(no-)?cdtext$/) {
	$cdtext = "$1" eq "";
    }

=item B<-langs> I<list>

Sets list of languages to use in CD-TEXT blocks. I<list> is a comma
separated list of country codes. Default is 9.

=cut
    
    elsif ($ARGV[0] eq '-langs') {
	shift @ARGV;
	@langs = split(',', uc($ARGV[0]));
    }

=item B<-disc-id> I<id> B<-disc-id->I<LANG> I<id>

Sets disc id.

=cut
    
    elsif ($ARGV[0] =~ /^-disc-id(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('DISC_ID', $2, $ARGV[0]);
    }
    
=item B<-title> I<string> B<-title->I<LANG> I<string>

Sets CD title for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-title(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('TITLE', $2, $ARGV[0]);
    }

=item B<-performer> I<string> B<-performer->I<LANG> I<string>

Sets CD performer for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-performer(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('PERFORMER', $2, $ARGV[0]);
    }

=item B<-songwriter> I<string> B<-songwriter->I<LANG> I<string>

Sets CD songwriter for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-songwriter(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('SONGWRITER', $2, $ARGV[0]);
    }

=item B<-composer> I<string> B<-composer->I<LANG> I<string>

Sets CD composer for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-composer(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('COMPOSER', $2, $ARGV[0]);
    }

=item B<-arranger> I<string> B<-arranger->I<LANG> I<string>

Sets CD arranger for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-arranger(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('ARRANGER', $2, $ARGV[0]);
    }

=item B<-message> I<string> B<-message->I<LANG> I<string>

Sets message to the user for first or for I<LANG> language.

=cut
    
    elsif ($ARGV[0] =~ /^-message(-(\w+))?$/) {
	shift @ARGV;
	process_glob_flag_opt('MESSAGE', $2, $ARGV[0]);
    }

=item B<-inherit-title> B<-no-inherit-title>

Enable or disable title inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-title$/) {
	$inherit{TITLE} = "$1" eq "";
    }

=item B<-inherit-performer> B<-no-inherit-performer>

Enable or disable performer inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-performer$/) {
	$inherit{PERFORMER} = "$1" eq "";
    }

=item B<-inherit-songwriter> B<-no-inherit-songwriter>

Enable or disable songwriter inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-songwriter$/) {
	$inherit{SONGWRITER} = "$1" eq "";
    }

=item B<-inherit-composer> B<-no-inherit-composer>

Enable or disable composer inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-composer$/) {
	$inherit{COMPOSER} = "$1" eq "";
    }

=item B<-inherit-arranger> B<-no-inherit-arranger>

Enable or disable arranger inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-arranger$/) {
	$inherit{ARRANGER} = "$1" eq "";
    }

=item B<-inherit-message> B<-no-inherit-message>

Enable or disable message inheritance.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-message$/) {
	$inherit{MESSAGE} = "$1" eq "";
    }

=item B<-inherit-all> B<-no-inherit-all>

Enable or disable inheritance of all CD-TEXT flags. Default is
to inherit all flags.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?inherit-all$/) {
	$inherit{$_} = "$1" eq "" for(@track_flags);
    }

=item B<-no-title>

Disable title in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-title') {
	$disable{TITLE} = 1;
    }

=item B<-no-performer>

Disable performer in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-performer') {
	$disable{PERFORMER} = 1;
    }

=item B<-no-songwriter>

Disable songwriter in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-songwriter') {
	$disable{SONGWRITER} = 1;
    }

=item B<-no-composer>

Disable composer in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-composer') {
	$disable{COMPOSER} = 1;
    }

=item B<-no-arranger>

Disable arranger in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-arranger') {
	$disable{ARRANGER} = 1;
    }

=item B<-no-message>

Disable message in all CD-TEXT blocks.

=cut
    
    elsif ($ARGV[0] eq '-no-message') {
	$disable{MESSAGE} = 1;
    }

=item B<-pregap> I<MM:SS:FF>

Sets the length of the pre-gap for each track.

=cut

    elsif ($ARGV[0] eq '-pregap') {
	shift @ARGV;
	$pregap = $ARGV[0];
	die "invalid pre-gap format"
	  unless $pregap =~ /^\d+:\d+:\d+$/;
    }

=item B<-path> B<-no-path>

Enable or disable directory part of file name in the FILE flag.
Default is to remove directory part from file name.

=cut
    
    elsif ($ARGV[0] =~ /^-(no-)?path$/) {
	$path = "$1" eq "";
    }
    
=item B<-subst-ext> I<extension>

Sets file extension to substitute for each audio file name. Disables
B<-append-ext>. Default is to substitute extension with .wav.

=cut
    
    elsif ($ARGV[0] eq '-subst-ext') {
	shift @ARGV;
	$subst_ext = $ARGV[0];
	$append_ext = undef;
    }
    
=item B<-append-ext> I<extension>

Sets file extension to append to each audio file name. Disables
B<-subst-ext>.

=cut
    
    elsif ($ARGV[0] eq '-append-ext') {
	shift @ARGV;
	$subst_ext = undef;
	$append_ext = $ARGV[0];
    }
    
=item B<-no-change-ext>

Do not change extension of audio file names. Disables
B<-subst-ext> and B<-append-ext>.

=cut
    
    elsif ($ARGV[0] eq '-no-change-ext') {
	$subst_ext = undef;
	$append_ext = undef;
    }
    
=item B<-plugin> I<file>[:I<opt1>[=I<value1>][,I<opt2>[=I<value2>]]...]

Loads plugin from I<file>. If I<file> has not contain a directory part, then
the program will first check the user plugins directory, then the system
plugins directory, and finally the current directory.

=cut

    elsif ($ARGV[0] eq '-plugin') {
        shift @ARGV;
        my $arg = $ARGV[0];
        my $pstr = $arg;
        my $ostr = '';
        ($pstr, $ostr) = ($1, $2) if $arg =~ /^(.+?):(.*)$/;
        load_plugin($pstr, parse_plugin_options($ostr));
    }

=item B<-convert->I<NAME>[:I<opt1>[=I<value1>][,I<opt2>[=I<value2>]]...]

Shortcut for B<-plugin> convert-I<NAME>.

=item B<-info->I<NAME>[:I<opt1>[=I<value1>][,I<opt2>[=I<value2>]]...]

Shortcut for B<-plugin> info-I<NAME>.

=item B<-input->I<NAME>[:I<opt1>[=I<value1>][,I<opt2>[=I<value2>]]...]

Shortcut for B<-plugin> input-I<NAME>.

=cut

    elsif ($ARGV[0] =~ /^-(convert|info|input)-(.+?)(:(.*))?$/) {
        load_plugin("$1-$2", parse_plugin_options($4));
    }

=item B<-list-plugins>

List available plugins and exit.

=cut
    
    elsif ($ARGV[0] eq '-list-plugins') {
	for my $dir($usrplugindir, $sysplugindir) {
	    for my $path(glob(catfile($dir, '*'))) {
		print basename($path)." at $dir\n";
	    }
	}
	exit;
    }
    
=item B<-plugin-info> I<file>

List information about plugin and exit.

=cut
    
    elsif ($ARGV[0] eq '-plugin-info') {
        shift @ARGV;
	my $name = basename($ARGV[0]);
        load_plugin($ARGV[0], undef);
	print "Name: $name\n";
	print "Purpose: $plugin_purpose{$name}\n";
	print "Options:\n";
	for my $i(@{$plugin_options{$name}}) {
	    print "  $$i[0]\n";
	    print "    $$i[1]\n";
	}
	exit;
    }
    
=item B<-help>

Display short usage help and exit.

=cut
    
    elsif ($ARGV[0] =~ /^--?(help|\?)$/) {
	print $usage;
	exit;
    }
    
=item B<-version>

Display version information and exit.

=cut
    
    elsif ($ARGV[0] =~ /^--?version$/) {
	print "mkcdtoc version $version\n";
	exit;
    }
    
    elsif ($ARGV[0] eq '--') {
	shift @ARGV;
	last;
    } 
    elsif ($ARGV[0] =~ /^-/) {
	die "unknown option: $ARGV[0]";
    }
    else {
	last;
    }
}

=back

=cut

if (@ARGV) {
    $if = $ARGV[0];
    die "cannot open $ARGV[0]: $!" unless open($if, '<', $ARGV[0]);
    unless (defined $input_plugin_hook) {
        if ($ARGV[0] =~ /\.m3u$/i) { load_plugin('input-m3u', undef) }
    }
}

load_plugin('input-raw', undef) unless defined $input_plugin_hook;

# load track data from input
my $track = &$input_plugin_hook($if, [@langs]);

# apply info plugins
for my $hook(@info_plugin_hook) {
    for my $ti(@$track) {
	&$hook($ti, [@langs]);
    }
}

# analyze received data
%track_use = ();
for my $fl(@track_flags) {
    $track_use{$fl} = 1 if defined $glob{$fl};
}
for my $ti(@$track) {
    for my $fl(@track_flags) {
	$track_use{$fl} = 1 if defined $$ti{$fl};
    }
}
for my $fl(keys(%disable)) {
    delete $track_use{$fl};
}
# perform inheritance
for my $ti(@$track) {
    for my $fl(keys(%track_use)) {
	next unless $inherit{$fl};
	for my $nl(0..$#langs) {
	    $ti->{$fl}->[$nl] = $glob{$fl}[$nl] unless defined $ti->{$fl};
	}
    }
}

$cdtext = keys(%track_use) > 0 unless defined $cdtext;

# print toc header
print $of "CD_DA\n";
if ($cdtext) {
    print $of "CD_TEXT {\n";
    print $of "  LANGUAGE_MAP {\n";
    for (my $nl = 0; $nl < @langs; $nl++) {
	print $of "    $nl: $langs[$nl]\n";
    }
    print $of "  }\n";
    for (my $nl = 0; $nl < @langs; $nl++) {
	print $of "  LANGUAGE $nl {\n";
	for my $fl(@glob_flags) {
	    print $of "    $fl \"".quote(defined $glob{$fl}[$nl] ?
		$glob{$fl}[$nl] : $glob{$fl}[0])."\"\n"
	      if defined $glob{$fl} || $track_use{$fl};
	}
	print $of "  }\n";
    }
    print $of "}\n";
}
print $of "\n";

# print track specifications
my $tc = 1;
for my $ti(@$track) {

    print $of "// Track $tc\n";
    print $of "TRACK AUDIO\n";
    if (defined $country && defined $owner &&
	defined $year && defined $serial) {
	printf $of "ISRC \"%s%s%02d%05d\"\n",
	  $country, $owner, $year, $serial;
    }
    print $of $copy ? "COPY\n" : "NO COPY\n";
    print $of $pre_emphasis ?
      "PRE_EMPHASIS\n" : "NO PRE_EMPHASIS\n";
    print $of $channels == 4 ?
      "FOUR_CHANNEL_AUDIO\n" : "TWO_CHANNEL_AUDIO\n";
    if ($cdtext) {
	print $of "CD_TEXT {\n";
	for (my $nl = 0; $nl < @langs; $nl++) {
	    print $of "  LANGUAGE $nl {\n";
	    for my $fl(@track_flags) {
		print $of "    $fl \"".quote($ti->{$fl}->[$nl])."\"\n"
		  if $track_use{$fl};
	    }
	    if (defined $country && defined $owner &&
		defined $year && defined $serial) {
		printf $of "    ISRC \"%s-%s-%02d-%05d\"\n",
		  $country, $owner, $year, $serial;
	    }
	    print $of "  }\n";
	}
	print $of "}\n";
    }

    if ($pregap) {
	print $of "PREGAP $pregap\n";
    }

    my $tf = $path ? $$ti{FILE} : basename($$ti{FILE});
    $tf =~ s/\.\w+$/$subst_ext/ if defined $subst_ext;
    $tf .= $append_ext if defined $append_ext;

    if (defined $convert_plugin_hook) {
	if ($$ti{FILE} ne $tf) {
	    &$convert_plugin_hook($$ti{FILE}, $tf);
	} else {
	    warn "input and output audio files has the same name, ".
	         "no convertion performed";
	}
    }

    print $of "FILE \"".quote($tf)."\" 0\n\n";
	    
    $tc++;
    $serial++ if defined $serial;
}

close($of);
close($if);

=head1 EXAMPLES

For example we have a set of WAVE files in the current directory, then we
want to make TOC file for them

    ls *.wav |mkcdtoc >disc.toc

For example we have a set of MP3 files in the current directory, then we
want to make TOC file with CD-TEXT blocks

    ls *.mp3 |mkcdtoc -plugin info-id3info >disc.toc

The same, but perform MP3 to WAVE conversion

    ls *.mp3 |mkcdtoc -plugin info-id3info \
    -plugin convert-mpg321 >disc.toc

=head1 FILES

=over

=item I<~/.mkcdtoc/plugins>

User plugins directory.

=item I</usr/pkg/share/mkcdtoc/plugins>

System plugins directory.

=back

=head1 AUTHOR

Konstantin Korikov <lostclus@ua.fm>

=head1 SEE ALSO

L<cdrdao(1)>, L<ls(1)>

=cut

# vim:ft=perl
