tsv2xp-xml.pl

   1 #!/usr/bin/perl
   2
   3 # sudo -u eprints /usr/share/eprints3/bin/import --verbose --migration ffzg eprint XML dipl.xml
   4
   5 use warnings;
   6 use strict;
   7
   8 use File::Slurp;
   9 use Data::Dump qw(dump);
  10
  11 my $tsv_file = 'items.mentor_ime.mentor_perzime.IME_FILE_a.PREZIME.IME.NAZIV_RADA.MENTOR.GOD_OBR63a8814e199c9b969dbe8251fdef0fa2';
  12
  13 our $eprintsid = 700;
  14
  15 my $xml = read_file 'ep-xml.xml';
  16 my @files = read_file "files.txt";
  17
  18 my $file2path;
  19 foreach my $full ( @files ) {
  20         chomp $full;
  21         my $file = $1 if $full =~ m{/([^/]+)$};
  22         $file =~ s/\.\w+$//;
  23         $file2path->{ lc $file } = $full;
  24 }
  25 #warn "# file2path ",dump($file2path);
  26
  27 print qq{<?xml version="1.0" encoding="utf-8" ?>
  28 <eprints>
  29 };
  30
  31 my @header;
  32 my $header2col;
  33 my $col = 0;
  34
  35 our @v;
  36 sub interpolate {
  37         my $f = shift;
  38         my $optional = $1 if $f =~ s{(\?)$}{};
  39         my $i = $header2col->{$f};
  40         die "no $f in ", dump( $header2col ) if not defined $i and not $optional;
  41         my $v = $v[$i];
  42         warn "# $f $i = $v\n";
  43         return $v;
  44 }
  45
  46
  47 open(my $tsv, '<', $tsv_file) || die "$tsv_file: $!";
  48 while(<$tsv>) {
  49         chomp;
  50         if ( m/#(.+)/ ) {
  51                 @header = split(/\t/, $1);
  52                 warn "# header ",dump( @header );
  53                 my $i = 0;
  54                 $header2col->{$_} = $col++ foreach @header;
  55                 warn "# header2col ",dump( $header2col );
  56                 next;
  57         }
  58
  59         @v = map { s/\\N//g; $_ } split(/\t/, $_);
  60         warn "# v = ", dump(@v);
  61
  62         my $file = interpolate 'IME FILE-a';
  63         $file =~ s/ //g;
  64         my $full_path;
  65         if ( my $full = $file2path->{ lc $file } ) {
  66                 $full_path = $full;
  67                 warn "# file $file -> $full_path\n";
  68         }
  69
  70         my $c = $col;
  71         $header2col->{'eprintsid'} = $c; $v[$c++] = $eprintsid++;
  72         $header2col->{'file'} = $c; $v[$c++] = $file;
  73         $header2col->{'full_path'} = $c; $v[$c++] = $full_path;
  74
  75         my $eprints = $xml;
  76         while ( $eprints =~ s/<!-- "(.+?)" -->/interpolate($1)/seg ) {
  77                 warn "# replaced $1\n";
  78         }
  79
  80         $eprints =~ s{<documents>.+</documents>}{<!-- no documents -->}s if ! $full_path;
  81
  82         print $eprints;
  83 }
  84
  85 print qq{
  86 </eprints>
  87 };
  88