#!/usr/bin/perl
# This script is PDS; Public Domain Software.
require 5.008;
use strict;
use warnings;
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";
binmode STDIN,  ":utf8";
if (@ARGV == 0) {
    print "Usage: vorbis-batch-comment <metadata-file>\n";
    exit 1;
}
&main;
exit;

sub main {
    my $fh_meta = do {
	if ($ARGV[0] eq '-') {
	    # STDINから讀む。
	    \*STDIN;
	}
	else {
	    my $fh;
	    open $fh, '<:utf8', $ARGV[0] or
	      die "failed to open $ARGV[0]\n";
	    $fh;
	}
    };

    my ($universal, $eachfile) = &parse_meta($fh_meta);
    foreach my $each (@$eachfile) {
	my $fname_head = $each->[0];
	my $tags = $each->[1];
	# このファイル名パターンにマッチするファイルは存在するか？
	my @matched_files = &find_files_with_head($fname_head);
	if (@matched_files == 0) {
	    warn "no files matched for [$fname_head]. skip...\n";
	}
	elsif (@matched_files > 1) {
	    warn "multiple files matched for [$fname_head]. skip...\n".
	      join(', ', map {"[$_]"} @matched_files)."\n";
	}
	else {
	    my $target = $matched_files[0];
	    print "setting tags for [$target]...\n";
	    my $combined = {};
	    @$combined{keys %$universal} = values %$universal;
	    @$combined{keys %$tags} = values %$tags;
	    # 一時ファイルを作る。
	    my $tmpfile = "/tmp/vbc.$$";
	    open my $tmpfh, '>:utf8', $tmpfile or
	      die "failed to make temporary file [$tmpfile].\n";
	    while (my ($key, $val) = each %$combined) {
		print $tmpfh "$key=$val\n";
	    }
	    undef $tmpfh;
	    eval {
		&get_processor($target)->($target, $tmpfile);
	    }; if ($@) {
		warn "$@";
	    }
	    unlink $tmpfile;
	}
    }
}

sub parse_meta {
    my $fh = shift;

    my $r_key = qr/[^;=]+/;
    my $r_value = qr/[^;]+/;
    my $r_pair = qr/$r_key\s*=\s*$r_value/;
    my $r_pairs = qr/$r_pair(?:\s*;\s*$r_pair)*/;

    my $r_each = qr/^(.+?)\s*;\s*($r_pairs)$/;

    my $univ = {};
    my @files;
    foreach (<$fh>) {
	s/^\s*|\s*$//g;
	next if /^#/; # コメント
	next if length == 0;

	if (/$r_each/) {
	    my $file = $1;
	    my $tags = {};
	    foreach my $pair (split /($r_pair)/, $2) {
		next if !defined $pair;
		next if $pair !~ /($r_key)\s*=\s*($r_value)/;
		my ($key, $val) = ($1, $2);
		$key =~ s/^\s*|\s*$//g;
		$val =~ s/^\s*|\s*$//g;
		warn "warning: key of tag [$pair] has [^A-Z] char.\n"
		  if $key =~ /[^A-Z]/;
		$tags->{$key} = $val;
	    }
	    if ($file eq '*') {
		# 共通
		@$univ{keys %$tags} = values %$tags;
	    }
	    else {
		push @files, [$file, $tags];
	    }
	}
	else {
	    die "parse error: $_\n";
	}
    }
    ($univ, \@files);
}

sub find_files_with_head {
    my $head = shift;
    my @matched;
    opendir my $dh, '.';
    while (defined($_ = readdir $dh)) {
	if (-f && /^$head/ && defined &get_processor($_)) {
	    push @matched, $_;
	}
    }
    @matched;
}

sub get_processor {
    my $fname = shift;
    my $processors = {
	ogg  => \&proc_ogg,
	flac => \&proc_flac,
    };
    if ($fname =~ /\.([^\.]+)$/) {
	$processors->{$1};
    }
    else {
	undef;
    }
}

sub proc_ogg {
    my ($fname, $tagfile) = @_;
    system 'vorbiscomment', '-w', $fname,
      '--raw', '-c', $tagfile
	and die "failed to use vorbiscomment: $!\n";
}

sub proc_flac {
    my ($fname, $tagfile) = @_;
    system 'metaflac', $fname,
      '--remove-vc-all', "--import-vc-from=$tagfile",
	'--no-utf8-convert', '--dont-use-padding'
	  and die "failed to use metaflac: $!\n";
}