##
## Edit: edit EPrints translations
##
##

use Apache::Const qw( REDIRECT OK );
use Apache::URI;
use Carp qw(cluck);

use strict;

##
my $DIR="/opt2/eprints2/ml";
my $TARGETCODE = "fr";
my $TEMPLATECODE = "en";
my $action="Edit-$TARGETCODE"; #the address of this file

my $FILES=[ {f=>"cfg/system-phrases-XX.xml",s=>"system-phrases",
             t=>"phrase",a=>"ref"},
            {f=>"defaultcfg/citations-XX.xml",s=>"citations",
             t=>"citation",a=>"type"},
            {f=>"defaultcfg/phrases-XX.xml",s=>"phrases",
             t=>"phrase",a=>"ref"},
            {f=>"defaultcfg/template-XX.xml",s=>"template",t=>""},
            {f=>"defaultcfg/static/XX/contact.xpage",s=>"contact",t=>""},
            {f=>"defaultcfg/static/XX/error401.xpage",s=>"error401",t=>""},
            {f=>"defaultcfg/static/XX/index.xpage",s=>"index",t=>""},
            {f=>"defaultcfg/static/XX/information.xpage",s=>"information",t=>""},
            {f=>"defaultcfg/static/XX/vlit.xpage",s=>"vlit",t=>""},
            {f=>"defaultcfg/static/XX/help/index.xpage",s=>"help/index",t=>""},
            {f=>"defaultcfg/subjects.xml",s=>"subjects",t=>"subject"}
          ];

###########################################################

my $R = Apache->request();
my $apr = Apache::Request->new($R);
my %params= $apr->param();


if( $apr->param("download") ne "" ){
    my ($file,$template,$type,$attr)=find_file($apr->param("download"));
    if(!open(FILE,"$DIR/$file")){
	$R->content_type("text/html; charset=utf-8");
        _error("Cannot open $file for reading"); exit 0;
    }
    $R->content_type("application/octet-stream");
    while(<FILE>){
       print $_;
    }
    close(FILE);
    exit 0;
}

$R->content_type("text/html; charset=utf-8");

if( scalar %params == 0){
    ## file to be edited
    print_head("Translating EPrints - $TARGETCODE");
    print <<HTML;
 
<p>Please choose the file which you want to edit:</p>
<form name="choose" action="$action" method="get" accept-charset="utf-8">
<p align="center">
HTML
    foreach my $F (@$FILES) {
       my $f= $F->{f}; $f =~ s/XX/$TARGETCODE/;
       my $title=$F->{s};
       print "<input type=\"submit\" name=\"edit\" value=\"$title\"><br>\n";
    }
    print <<TAIL;
</p>
<hr>
<p>
<input type="submit" name="help" value="About"> the details of EPrints
translation program.
</p>
</form>
<hr><p>
Thist script was written by Laszlo Csirmaz, Central European University.
</p><p>
It is a 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.
</p><p>
It 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.

</p>
</body>
</html>

TAIL
    exit 0;
}

if( $apr->param("help") ne "" ){
    print_head("About Translating EPrints");
    print <<HELP1;
<p>These pages let you modify the nationalized EPrints configuration files.
These include phrases, citation, template files, and the subject.</p>
<h3>Phrases, citation and subject</h3>
<p>The page starts with a <b>Generate new instance of this file</b> button.
All modification is stored incrementally (i.e. new modifications are
appended), and pressing this button generates a new file incorporating all
changes, while making a backup. After making several dozen changes it is
advisable to use this button. Only freshly generated instances can be used
by EPrints.</p>
<p>Each phrase of citation must be edited separately. Each item is listed
separately, giving the English version first, then in an edit window, the
target language version. After editing or correcting you must press the
<b>CHANGE</b> button just above the field to store the modifications. There
is no way to store two items with a single click.</p>
<p>Changes are appended to the edited file, thus it is possible to rewind
unwanted changes; however it must be done by directly editing the modified
file.</p>

<h3>Template files</h3>
<p>Template files are presented in a single window, followed by the
reference text. You can open two windows: one showing the original, the
other the edited page. Pressing the <b>CHANGE</b> button writes the whole
file and makes a backup of the previous one.</p>

<h3>Site parameters</h3>
<p>This site is set-up to edit language <b>$TARGETCODE</b> and use
<b>$TEMPLATECODE</b> language text as reference. The files are stored in the
<b>$DIR</b> directory - supposedly under the EPrints tree.</p>
<p>To change these values, please edit the <b>\$TARGETCODE</b>,
<b>\$TEMPLATECODE</b> and <b>\$DIR</b> perl variables in the source of
this page. The value of <b>\$action</b> should be the name of the source
file, by default it is <b>Edit-XX</b>, where <b>XX</b> is replaced by 
<b>\$TARGETCODE</b>.
</p>
<h3>Localization</h3>
<p>The source of this page should go into the <b>cgi/</b> directory of 
the EPrints tree, and referred to as <b>http://this.site.edu/perl/Edit-XX</b>
</p>
<p>The <b>\$DIR</b> directory contains the template and target files as
well. It <b>must</b> contain the following template files - where <b>XX</b> is
replaced by <b>\$TEMPLATECODE</b>:
<ul>
HELP1
    foreach my $F (@$FILES) {
        print "<li>",$F->{f},"\n";
    }
    print <<HELP2;
</ul>
The target files, where <b>XX</b> is replaced by <b>\$TARGETCODE</b> are offered 
for editing.<br>
<b>WARNING</b>
This script has a limited parsing capacity, thus all files must obey extra
formatting rules, mainly that phrases, citations and subject must start in
separate lines. Please follow the formatting convetions of the standard
EPrints files.
</p>

HELP2
    exit 0;
}

if( $apr->param("edit") ne "" ){
    print_material($apr->param("edit"));
    exit 0;
}

if( $apr->param("change") ne "" ){
## CHANGE button was hit
    my $tt=$apr->param("change");
    my ($file,$template,$type,$attr)=find_file($tt);
    my $title=$tt;
    $title =~ s/^.*\///g; $title =~ s/\.[a-zA-Z]*$//; $title =~ s/\-..$//;
    if( $type eq "" ){
       ## template file
       ## rename the old file, and copy the new one
       _rename("$DIR/$file");
       if(! open(FILE,">$DIR/$file")){
          _error("Cannot open $file for writing"); exit 0;
       }
       print FILE $apr->param("Text");
       close(FILE);
       print_head("Editing &quot;$title&quot; - $TARGETCODE (edited)");
       print_template("$DIR/$template","$DIR/$file",$tt);
       print_tail();
       exit 0;
    } elsif( $type eq "subject" ){
       ##subject file
       my $pm="SA";
       foreach my $p (keys %params ){
          next if ( $p !~ /^S(.+)$/ );
          my $key=$1; $pm="S$key";
          append_subject("$DIR/$file",$key,$apr->param($p));
       }
       print_head("Editing &quot;$title&quot; - $TARGETCODE (edited)");
       print_subjects(read_subjects_xml("$DIR/$file"),$tt);
       print_tail();
       exit 0;
    } else {
       ## citation or phrase
       my $ra=read_xml("$DIR/$template",$type,$attr);
       my $rh=read_xml("$DIR/$file",$type,$attr);
       my $pm="T1";
       foreach my $p (keys %params ){
          next if( $p !~ /^T[0-9]+$/ );
          my $cnt=0;
          foreach my $key (sort {$ra->{$a}[0] <=> $ra->{$b}[0]} (keys %{$ra}) ){
             $cnt++;
             next if( "$p" ne "T$cnt" );
             $pm=$p;
             append_xml("$DIR/$file",$type,$attr,$key,$apr->param($p));
             $rh->{$key}[1]=$apr->param($p);
          }
       }
       print_head("Editing &quot;$title&quot; - $TARGETCODE (edited)");
       print_phrases($ra,$rh,$tt);
       print_tail();
       exit 0;
    }
}

if( $apr->param("commit") ne "" ){
## commit button
    my $tt=$apr->param("commit");
    commit_xml($tt);
    print_material($tt);
    exit 0;
}


_error("Don't know what to do");

exit 0;

###############################################
## sub _error($error_text)
##

sub _error {
    my $text=shift;
    print <<ERROR;
<html>
<head><title>Editing EPrints Error</title></head>
<body>
<h1> Error</h1>

<p>$text</p>

</body>
</html>
ERROR
}

#########################################################
## print_material($shortname)
##

sub print_material {
    my $tt = shift;
    my ($file,$template,$type,$attr)=find_file($tt);
    my $title=$tt;
    $title =~ s/^.*\///g; $title =~ s/\.[a-zA-Z]*$//; $title =~ s/\-..$//;
    print_head("Editing &quot;$title&quot; - $TARGETCODE");
    if($type eq "" ){
       ## template file
       print_template("$DIR/$template","$DIR/$file",$tt);
    } elsif( $type eq "subject" ){
       ## subject file
       print_subjects(read_subjects_xml("$DIR/$file"),$tt);
    } else {
       ## citation or phrase
       print_phrases(read_xml("$DIR/$template",$type,$attr),
                     read_xml("$DIR/$file",$type,$attr),$tt);
    }
    print_tail();
}

#####################################################
## sub ($file,$template,$type,$attr) = find_file($shortname)
## returns the file attributes name determined from its short name

sub find_file {
    my $param=shift;
    foreach my $F (@$FILES) {
       next if ($param ne $F->{s});
       my $f=$F->{f};my $t=$f; $f =~ s/XX/$TARGETCODE/;
       $t =~ s/XX/$TEMPLATECODE/;
       return ($f,$t,$F->{t},$F->{a});
    }
    _error("Cannot find $param"); exit 0;
}


########################################
## $hash = read_xml($file,$phrase,$attr)
## return a hash of expressions in the xml file
##  a rudimentary xml parser: looks for text between 
##    <ep:${phrase}s ...> and </ep:${phrase}s> 
##  and then collects entries of the form
##    <ep:$phrase $attr="XXX">YYYY</ep:$phrase>
##  Then $hash->{XXX}[0]= line number for ordering them;
##       $hash->{XXX}[1]= "YYYY"
##  Both <ep:...> must start on separate line.
##  Read until the file is exhausted

sub read_xml {
    my ($file,$tag,$attr)=@_;
    my %hash;
    my $tags=$tag."s";
    my $lineno=0;
    if(!open(FILE,$file)){ 
        _error("Cannot open xml file $file"); exit 0;
    }
    my $inside=0;
    while(<FILE>){
      $lineno++;
      if($inside==0){
         next if(! /\<ep:$tags/ );
         $inside=1; s/^.*\<ep:$tags//;
      } 
      if($inside==1){
         next if(! />/ );
         $inside=2; s/^.*>//;
      } 
      if ($inside==2){
         if( s/^\s*\<\/ep:$tags\>// ){
             $inside=0;
         } elsif( s/^\s*<ep:$tag\s+$attr=\"([^\"]+)\"\s*>// ){
             my $l=$lineno;
             $hash{$1}=[$l,read_tag($_,"</ep:$tag>",\$lineno)];
         }
      }
    }
    close(FILE);
    if(! $inside == 0){
       _error("Unexpected end of xml file $file"); exit 0;
    }
    return \%hash;
}

sub read_tag {
    my ($thisline,$endtag,$lineno)=@_;
    my $res="";
    while(1){
      $thisline =~ s/^\s*//;
      if( $thisline =~ /^(.*)$endtag\s*$/ ){
          return $res.$1;
      }
      if( $thisline =~ /$endtag/ ){
          _error("Error in xml file lineno=$$lineno"); exit 0;
      }
      $res.=$thisline;
      if(eof(FILE)){
         _error("unexpected end of xml file"); exit 0;
      }
      $thisline=<FILE>; $$lineno++;
    }
    return "";
}

######################################################
## sub print_phrases($reference_hash,$edit_hash)
## prints an editable phrases list produced from two hashes

sub print_phrases {
    my($ra,$rh,$ref)=@_;

    ## commit code and download code
    print <<COMMIT;
<table width="100%"><tr><td>
<form name="gen" action="$action" method="get">
<input type="hidden" name="commit" value="$ref">
<input type="submit" name="submit" value="Generate">
new instance of this file</form></td>
<td><form name="download" action="$action" method="get">
<input type="hidden" name="download" value="$ref">
<input type="submit" name="submit" value="Download"> this page
</form></td></tr></table>
<hr>
COMMIT

    my $cnt=0;
    foreach my $key (sort {$ra->{$a}[0] <=> $ra->{$b}[0]} (keys %{$ra}) ){
      $cnt++;
      my $atxt=$ra->{$key}[1];
      my $rtxt="";
      if( defined($rh->{$key}) ){
	   $rtxt=$rh->{$key}[1]; $rh->{$key}[0]=-1;
      }
      my $lnno=scalar split("\n",$rtxt);
      print "<form name=\"e$cnt\" action=\"$action#T$cnt\" method=\"post\" accept-charset=\"utf-8\">\n";
      print "<p><font face=\"Verdana\" size=\"2\"><a name=\"T$cnt\"><b>$key</b></a> (T$cnt)<br>\n";
      print "<input type=\"hidden\" name=\"change\" value=\"$ref\">\n";
      print "<input type=\"submit\" name=\"submit\" value=\"CHANGE\">\n";
      print escape($atxt,1),"<br>\n";
      print "<textarea name=\"T$cnt\" cols=\"100\" rows=\"$lnno\">\n",
             escape($rtxt),"</textarea></font></p></form>\n";
    }
    print "<p/><hr><p />\n";
    print "<h2>Remained</h2>\n";
    foreach my $key (sort {$rh->{$a}[0] <=> $rh->{$b}[0]} (keys %{$rh}) ){
      next if($rh->{$key}[0] < 0 );
      print "<p><font face=\"Verdana\" size=\"2\"><b>$key</b><br>\n";
      print escape($rh->{$key}[1],1),"</font><p>\n";
    }
}

#########################################################
## sub append_xml($file,$phrase,$attr,$tag,$value)
##

sub append_xml {
    my($file,$phrase,$attr,$tag,$value) = @_;
    if(!open(FILE,">>$file")){
       _error("Cannot open xml file $file for writing"); exit 0;
    }
    binmode(FILE);
    print FILE "\n<ep:",$phrase,"s>\n<ep:$phrase $attr=\"",
         $tag,"\">$value</ep:$phrase>\n</ep:$phrase","s>\n";
    close(FILE);
}

###########################################################
## sub commit_xml($shortname)
## replace the xml file with a copy of the template with text replaced
##  from the edited file

sub commit_xml {
    my $shortname=shift;
    my ($file,$template,$phrase,$attr)=find_file($shortname);
    if( $phrase eq "subject" ){
        commit_subject($file);
        return;
    }
    if( ! defined $attr || !$attr ){
       _error("Cannot commit $shortname");
       exit 0;
    }
    my $rh=read_xml("$DIR/$file",$phrase,$attr);
    ## rename the old file
    _rename("$DIR/$file");
    ## open $template for reading, $file for writing
    if(! open(FILE,">$DIR/$file")){
       _error("Cannot open $file for writing"); exit 0;
    }
    if(! open(TEMP,"$DIR/$template")){
       _error("Cannot open $template"); exit 0;
    }
    my $inside=0;
    my $phrases=$phrase."s";
    while(<TEMP>){
       if($inside==0){
           if(! /<ep:$phrases/ ){
               s/(<\?xml\s+.*encoding=\")[^\"]+\"/$1utf-8\"/;
               s/(<\!DOCTYPE\s+.*SYSTEM\s+\"entities-)..\.dtd\"/$1$TARGETCODE.dtd\"/;
               print FILE $_; next;
           }
           $inside=1; s/^(.*<ep:$phrases)//; print FILE $1;
       }
       if($inside==1){
           if(! />/ ){
               print FILE $_; next;
           }
           $inside=2; s/^(.*>)//; print FILE $1;
       }
       if($inside==2){
          if( s/^(\s*\<\/ep:$phrases\>)// ){
              print FILE $1; $inside=0;
          } elsif ( s/^(\s*<ep:$phrase\s+$attr=\")([^\"]+)\"\s*>// ){
             my $tag=$2; 
             print FILE $1,$tag,"\">",$rh->{$tag}[1],"</ep:$phrase>\n";
             skip_tag($_,"</ep:$phrase>");
          } else {
             print FILE $_;
          }
       }
    }
    close(TEMP);
    close(FILE);
}

sub skip_tag {
    my ($thisline,$endtag)=@_;
    my $res="";
    while(1){
       return if( $thisline =~ /$endtag\s*$/ );
       if(eof(TEMP)){
           _error("unexpected end of template xml file"); exit 0;
       }
       $thisline=<TEMP>;
    }
}


############################################################
## sub $escaped = escape($str,$nl)
##  escapes &,<,>, quotation mark and non-ascii chars, 
##  replaces newlines by <br> if $nl is defined

sub escape {
    use bytes;
    my ($str,$nl)=@_;
    $str =~ s/\&\#([0-9]+);/XmlUtf8Encode($1)/eg;
    $str =~ s/\&\#x([0-9a-f]+);/XmlUft8Encode(hex($1))/egi;
    $str =~ s/\&/\&amp;/g; $str =~ s/\"/&quot;/g;
    if( defined $nl ){
        $str =~ s/<([^>]*)>/<span style=\"background-color:#DDDDDD;\">&lt;$1&gt;<\/span>/g;
        $str =~ s/<([^>]*)$/<span style=\"background-color:#DDDDDD;\">&lt;$1/; 
        $str =~ s/^([^<]*)>/$1&gt;<\/span>/;
    } else {
        $str =~ s/</&lt;/g; $str =~ s/>/&gt;/g; 
    }
    $str =~ s/([\xc0-\xdf].|[\xe0-\xef]..|[\xf0-\xff]...)/XmlUtf8Decode($1)/egs;
    $str =~ s/\n/<br>\n/gs if(defined $nl && $nl ne 2);
    return $str;
}

sub XmlUtf8Decode {
    my ($str)=@_;
    my $len=length($str);
    my @t=unpack "C*",$str;
    my $n;
    if($len == 2){
       $n=(($t[0]&0x3f)<<6)+($t[1] & 0x3f);
    }elsif($len == 3) {
       $n=(($t[0]&0x1f)<<12)+(($t[1]&0x3f)<<6)+($t[2]&0x3f);
    } else {
       $n=(($t[0]&0x0f)<<18)+(($t[1]&0x3f)<<12)+(($t[2]&0x3f)<<6)+($t[3]&0x3f);
    }
    return sprintf "&#x%x;", $n;
}

sub XmlUtf8Encode {
    my $n = shift;
    if ($n < 0x80){
	return chr ($n);
    } elsif ($n < 0x800){
	return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
    } elsif ($n < 0x10000){
	return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
		     (($n & 0x3f) | 0x80));
    } else {
	return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
		     ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
    }
}


#########################################################
## sub print_template($template,$file)
##

sub print_template {
    my ($tmpfile,$file,$ref)=@_;
    print <<HEAD;
<form name="download" action="$action" method="get">
<p>
<input type="hidden" name="download" value="$ref">
<input type="submit" name="submit" value="DOWNLOAD"> this page
</p></form>
<hr>
<form name="temp" action="$action" method="post" accept-charset="utf-8">
<p>
<input type="hidden" name="change" value="$ref">
<input type="submit" name="submit" value="CHANGE"><br>
<textarea name="Text" cols="100" rows="40">
HEAD
    if(!open(FILE,$file)){
         _error("Cannot open file $file"); exit 0;
    }
    while(<FILE>){
       print escape($_);
    }
    close(FILE);
    print <<MEDD;
</textarea></p></form>
<hr>
<pre style="font-size:2">
MEDD
    if(!open(FILE,$tmpfile)){
        _error("Cannot open file $tmpfile"); exit 0;
    }
    while(<FILE>){
       print escape($_,2);
    }
    close(FILE);
    print <<TAIL;
</pre>

TAIL
}

##################################################
## print_head($title)
##

sub print_head {
    my $title=shift;
    print <<HEAD;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Traditional//EN"
   "http://www.w3.org/TR/REC-html40/loose.dtd">

<html>
<head>
<title>$title</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
<h1> $title </h1>

HEAD
}

sub print_tail {
    print "
</body>
</html>
";
}

###################################################
## _rename($file)
## rename $file to $file.XXXXXX for some random XXXXXX

sub _rename {
    my $file=shift;
    my $tmp=`mktemp "$file.XXXXXX"`;
    chomp ($tmp);
    `mv -f "$file" "$tmp"`;
}

###################################################
##  $hash = read_subjects_xml($file)
##  subjects are hashed by their ID, $hash->{$id} = { XX => $lang, ... }
##  The subject xml file has the following format:
##  <eprintsdata>...</eprintsdata>
##     <record>...</record>
##         <field name="subjectid">$id</field>
##         <field name="name">...</field>
##           <lang id="XX">$lang</lang>
##   there are further fields as well
##  The routine below assumes that records start at a new line

sub read_subjects_xml {
    my ($file,$readall) = @_;
    my %hash;
    my $lineno=0;
    if(!open(FILE,$file)){
        _error("Cannot open subjects xml file $file"); exit 0;
    }
    my $inside=0; my $subjectid; my $langs;
    while(<FILE>){
       $lineno++;
       if($inside==0){
           next if(! s/^\s*\<eprintsdata\s*\>// );
           $inside=1;
       }
       if($inside==1){ ## inside eprintsdata
           if( /^\s*<\/eprintsdata>\s*$/){
               $inside=0; next;
           }
           next if(! s/^\s*\<record\s*\>// );
           undef $langs; undef $subjectid;
           $inside=2;
       }
       if($inside==2){ ## inside a <record>
           if( s/^\s*\<field\s+name=\"([^\"]+)\"\s*\>// ){
               my $name=$1;
               if( $name eq "subjectid" ){
                   $subjectid= read_field($_,\$lineno);
               } elsif( $name eq "name" ){
                   $langs=read_langs($_,\$lineno);
               } else {
                   my $fld=read_field($_,\$lineno);
                   if( defined($readall) && defined($subjectid)){
                      $hash{$subjectid}{"_$name"} = $fld;
                   }
               }
           } elsif( s/^\s*<\/record\s*>// ){
               if(!defined $subjectid || !defined $langs){
                   _error("Error in subject xml file line $lineno");
                   exit(0);
               }
               $inside=1; 
               foreach my $key( keys %$langs){ 
                   $hash{$subjectid}{$key}=$langs->{$key};
               }
           }
       }
    }
    close(FILE);
    return \%hash;
}

sub read_field {
    my ($thisline,$lineno)=@_;
    my $res="";
    while(1){
        $thisline =~ s/^\s*//;
        if( $thisline =~ /^(.*)\<\/field>\s*$/ ){
           return $res.$1;
        }
        if( $thisline =~ /\<\/field\>/ ){
           _error("Error in subject xml file lineno=$$lineno"); exit 0;
        }
        $res.=$thisline;
        if(eof(FILE)){
            _error("unexpected end of subject xml file"); exit 0;
        }
        $thisline=<FILE>; $$lineno++;
    }
    return "";
}

sub read_langs {
    my($thisline,$lineno)=@_;
    my %langs; 
    my $inside=0; my $langid=""; my $langtxt="";
    while(1){
       if( $thisline =~ /^\s*$/ ){
           if(eof(FILE)){
              _error("unexpected end of subject xml language"); exit 0;
           }
           $thisline = <FILE>;
       }
       if( $inside==0 ){
           if( $thisline =~ /^\s*<\/field>/ ){
               return \%langs;
           }
           if( $thisline !~ s/^\s*\<lang\s+id=\"([^\"]+)\"\s*\>// ){
               _error("wrong language field in subject xml, line $$lineno");
               exit 0;
           }
           $langid=$1; $langtxt=""; $inside=1;
       }
       if( $inside==1 ){
           if( $thisline =~ s/^(.*)\<\/lang\>// ){
               $langtxt .= $1; $langs{$langid}=$langtxt;
               $inside=0; next;
           }
           $langtxt .= $thisline; $thisline="";
       }
    }
    return "";
}

######################################################
## print_subjects($hash,$ref)
##

sub print_subjects {
    my($hash,$ref)=@_;
    ## commit code
    print <<COMMIT;
<table width="100%"><tr><td>
<form name="gen" action="$action" method="get">
<input type="hidden" name="commit" value="$ref">
<input type="submit" name="submit" value="Generate">
new instance of this file</form></td>
<td><form name="download" action="$action" method="get">
<input type="hidden" name="download" value="$ref">
<input type="submit" name="submit" value="Download"> this page
</form></td></tr></table>
<hr>
COMMIT

    foreach my $key (sort (keys %$hash ) ) {
      print "<form name=\"s$key\" action=\"$action#S$key\" method=\"post\" accept-charset=\"utf-8\">\n";
      print "<p><font face=\"Verdana\" size=\"2\"><a name=\"S$key\"><b>$key</b></a><br>\n";
      print "<input type=\"hidden\" name=\"change\" value=\"$ref\">\n";
      print "<input type=\"submit\" name=\"submit\" value=\"CHANGE\">\n";
      print escape($hash->{$key}{$TEMPLATECODE}),"<br>\n";
      print "<textarea name=\"S$key\" cols=\"100\" rows=\"1\">\n",
            escape($hash->{$key}{$TARGETCODE}),"</textarea></font></p></form>\n";
    }
    print "<hr>\n";
}

####################################################
## sub append_subject($file,$id,$value)
##

sub append_subject {
    my($file,$id,$value) = @_;
    if(!open(FILE,">>$file")){
       _error("Cannot open subject xml file \"$file\" for writing"); exit 0;
    }
    binmode(FILE);
    print FILE "
<eprintsdata>
  <record>
    <field name=\"subjectid\">$id</field>
      <field name=\"name\">
        <lang id=\"$TARGETCODE\">$value</lang></field>
  </record>
</eprintsdata>
";
    close(FILE);
}

########################################################
##  commit_subject($file)
##

sub commit_subject {
    my $file=shift;
    ## rename the old file
    my $hash = read_subjects_xml("$DIR/$file",1); #read all fields
    _rename("$DIR/$file");
    if(! open(FILE,">$DIR/$file")){
       _error("Cannot open subject file \"$file\" for writing"); exit 0;
    }
    print FILE <<SUBJECTHEAD;
<?xml version="1.0" encoding="utf-8" standalone="yes" ?>
<!DOCTYPE subjects >

<eprintsdata>
SUBJECTHEAD
    foreach my $key (sort (keys %$hash ) ) {
        print FILE  " <record>\n";
        print FILE  "   <field name=\"subjectid\">$key</field>\n";
        print FILE  "   <field name=\"name\">";
        my $hh=$hash->{$key};
        foreach my $field ( sort ( keys (%$hh)) ){
           next if( $field =~ /^_/ );
           print FILE "\n     <lang id=\"$field\">",$hh->{$field},"</lang>";
        }
        print FILE "</field>\n";
        foreach my $field (sort ( keys (%$hh)) ){
           next if( $field !~ s/^_// );
           print FILE "   <field name=\"$field\">",$hh->{"_$field"},"</field>\n";
        }
        print FILE " </record>\n";
    }
    print FILE "</eprintsdata>\n\n";
    close(FILE);
}