#!/usr/bin/perl

# ./tsv2xp-xml.pl 2>/dev/null > ep-diplomski.xml
# sudo -u eprints /usr/share/eprints3/bin/import --verbose --migration ffzg eprint XML ep-diplomski.xml

use warnings;
use strict;

use File::Slurp;
use Data::Dump qw(dump);

my $tsv_file = ( glob 'items.*' )[0];

our $eprintsid = 700;

my $xml = read_file 'ep-xml.xml';
my @files = read_file "files.txt";

my $file2path;
foreach my $full ( @files ) {
	chomp $full;
	my $file = $1 if $full =~ m{/([^/]+)$};
	$file =~ s/\.\w+$//;
	$file2path->{ lc $file } = $full;
}
#warn "# file2path ",dump($file2path);

print qq{<?xml version="1.0" encoding="utf-8" ?>
<eprints>
};

my @header;
my $header2col;
my $col = 0;

our @v;
sub interpolate {
	my $f = shift;
	my $optional = $1 if $f =~ s{(\?)$}{};
	my $i = $header2col->{$f};
	die "no $f in ", dump( $header2col ) if not defined $i and not $optional;
	my $v = $v[$i];
	warn "# $f $i = $v\n";
	return $v;
}


open(my $tsv, '<', $tsv_file) || die "$tsv_file: $!";
while(<$tsv>) {
	chomp;
	if ( m/#(.+)/ ) {
		@header = split(/\t/, $1);
		warn "# header ",dump( @header );
		my $i = 0;
		$header2col->{$_} = $col++ foreach @header;
		warn "# header2col ",dump( $header2col );
		next;
	}

	@v = map { s/\\N//g; $_ } split(/\t/, $_);
	warn "# v = ", dump(@v);

	my $file = interpolate 'IME FILE-a';
	$file =~ s/ //g;
	my $full_path;
	if ( my $full = $file2path->{ lc $file } ) {
		$full_path = $full;
		warn "# file $file -> $full_path\n";
		$file .= $1 if $full_path =~ m/(\.\w+)$/;
	}

	my $subject;
	if ( $file =~ m/^(\d+)(\w+)$/ ) {
		$subject =
			$2 =~ m/bib/i       ? 'IZBIB' :
			$2 =~ m/[info]{4}/i ? 'IZDHI' :
			$2 =~ m/muz/i       ? 'IZMUZ' :
			$2 =~ m/arh/i       ? 'IZARH' :
			die "unknown subject: $2";
	}

	my $c = $col;
	$header2col->{'eprintsid'} = $c; $v[$c++] = $eprintsid++;
	$header2col->{'file'} = $c; $v[$c++] = $file;
	$header2col->{'full_path'} = $c; $v[$c++] = $full_path;
	$header2col->{'subject'} = $c; $v[$c++] = $subject;

	my $eprints = $xml;
	while ( $eprints =~ s/<!-- "(.+?)" -->/interpolate($1)/seg ) {
		warn "# replaced $1\n";
	}

	$eprints =~ s{<documents>.+</documents>}{<!-- no documents -->}s if ! $full_path;
	$eprints =~ s{<subjects>.+</subjects>}{<!-- no subjects -->}s if ! $subject;

	print $eprints;
}

print qq{
</eprints>
};

