use utf8;
use XML::LibXML;
use POSIX qw(strftime);

$\ = "\n"; $, = "\t";

$filename = shift;
$/ = undef;

open FILE, $filename;
binmode (FILE, ":utf8");
$xml = <FILE>;
close FILE;

#get text, before and after
if ($xml =~ m/(^.+?<text[^>]*>\s*)(.+?)(<\/text>.+)/s) {
	$before = $1; $text = $2; $after = $3;
};
	
	#delete paragraphs created in TEITOK
 	$text =~ s/<\/?p[^>]*>//g;
 	$text =~ s/ //g; 	
 	$text =~ s/&#xA0;//g; 
 	$text =~ s/\n\n+/\n/g; 
		
    #abbr (first regex in script, since the markup is <>)
   	$text =~ s/&lt;(.+?)&gt;/<ex>$1<\/ex>/g;
   
	#column break (cb)
	$text =~ s/\{([a-z])\}/<cb n="$1"\/>/g;
	
	#line break (lb)
   	$text =~ s/\{(\d+)\}/<lb n="$1"\/>/g;
   	
   	#line break in margins
   	$text =~ s/\|/<lb\/>/g;
	
	#pb (page break)
	$text =~ s/\{h(\S)/\{h $1/g; #{h7} -> {h 7}, maybe forgotten space
   	$text =~ s/\{h +(\d+(r|v|))\}/<pb n="$1"\/>/g;
   	
   	#pb cb (page break + column break)
   	$text =~ s/\{h +(\d+(r|v))([a-z])\}/<pb n="$1"\/> <cb n="$3"\/>/g;
   	$text =~ s/\{h +(\d+)([a-z])\}/<pb n="$1"\/> <cb n="$3"\/>/g;
   	
 	#gaps (and unknown number of characters)
  	$text =~ s/\[roto\]/<gap reason="roto"\/>/g;
  	$text =~ s/\[doblez\]/<gap reason="doblez"\/>/g;
  	$text =~ s/\[mancha\]/<gap reason="mancha"\/>/g;
  	$text =~ s/\[tachado\]/<del type="tachado"\/>/g; #Victor
	$text =~ s/\[cancelado\]/<del type="cancelado"\/>/g; #Victor
	$text =~ s/\[borrado\]/<del type="borrado"\/>/g; #Victor
  	$text =~ s/\[raspado\]/<del type="raspado"\/>/g; #Victor
  	$text =~ s/\[subpuntuado\]/<del type="subpuntuado"\/>/g; #Victor
  	$text =~ s/\[blanco\]/<gap reason="blanco"\/>/g;
  	$text =~ s/\[\*\*\*\]/<gap reason="ilegible"\/>/g;
  	$text =~ s/\[\* \* \*\]/<gap reason="ilegible"\/>/g;
  	
  	#gaps (and known number of characters)
  	$text =~ s/(\*+)/<gap reason="ilegible" extent="$1"\/>/g; #Victor
  	$text =~ s/ extent="\*"/ extent="1 char"/g; #Victor
  	$text =~ s/ extent="\*\*"/ extent="2 chars"/g; #Victor
  	$text =~ s/ extent="\*\*\*"/ extent="3 chars"/g; #Victor
  	$text =~ s/ extent="\*\*\*\*"/ extent="4 chars"/g; #Victor
  	$text =~ s/ extent="\*\*\*\*\*"/ extent="5 chars"/g; #Victor
  	$text =~ s/ extent="\*\*\*\*\*\*+"/ extent="6 or more chars"/g; #Victor
  	
  	#signo, sello, crismón, cruz
  	$text =~ s/\[sello\]/<figure type="sello"\/>/g;
  	$text =~ s/\[crism&#xF3;n\]/<figure type="crismón"\/>/g;
	$text =~ s/\[crismón\]/<figure type="crismón"\/>/g;
  	$text =~ s/\[cruz\]/<figure type="cruz"\/>/g;
  	$text =~ s/\[signo\]/<figure type="signo"\/>/g;
  	$text =~ s/\[quir&#xF3;grafo\]/<figure type="quirógrafo"\/>/g;
	$text =~ s/\[quirógrafo\]/<figure type="quirógrafo"\/>/g;
	$text =~ s/\[signo:\s*([^\]]+)\]/<figure type="signo">$1<\/figure>/g;
  
   	#conjetura (supplied)
   	$text =~ s/\[roto:\s*([^\]]+)\]/<supplied reason="roto">$1<\/supplied>/g;
   	$text =~ s/\[doblez:\s*([^\]]+)\]/<supplied reason="doblez">$1<\/supplied>/g;
   	$text =~ s/\[mancha:\s*([^\]]+)\]/<supplied reason="mancha">$1<\/supplied>/g;
   	$text =~ s/\[conjetura:\s*([^\]]+)\]/<supplied>$1<\/supplied>/g;
   	
   	#duda (unclear)
   	$text =~ s/\[duda:\s*([^\]]+)\]/<unclear>$1<\/unclear>/g;
   	$text =~ s/\[duda ilegible:\s*([^\]]+)\]/<unclear reason="ilegible">$1<\/unclear>/g; #Victor
   	$text =~ s/\[duda roto:\s*([^\]]+)\]/<unclear reason="roto">$1<\/unclear>/g; #Victor
   	$text =~ s/\[duda doblez:\s*([^\]]+)\]/<unclear reason="doblez">$1<\/unclear>/g; #Victor
   	$text =~ s/\[duda mancha:\s*([^\]]+)\]/<unclear reason="mancha">$1<\/unclear>/g; #Victor
   	
   	#highlighted text (hi)
   	$text =~ s/\[subrayado:\s*([^\]]+)\]/<hi rend="subrayado">$1<\/hi>/g;
   	$text =~ s/\[impreso:\s*([^\]]+)\]/<hi rend="impreso">$1<\/hi>/g;
   	
   	#foreign
   	$text =~ s/\[lat(\.|):\s*([^\]]+)\]/<foreign xml:lang="la">$2<\/foreign>/g;
   	$text =~ s/\[lat&#xED;n:\s*([^\]]+)\]/<foreign xml:lang="la">$1<\/foreign>/g; #Victor
	$text =~ s/\[latín:\s*([^\]]+)\]/<foreign xml:lang="la">$1<\/foreign>/g; #Victor
   	$text =~ s/\[latin:\s*([^\]]+)\]/<foreign xml:lang="la">$1<\/foreign>/g; #Victor
   	$text =~ s/\[gal(\.|):\s*([^\]]+)\]/<foreign xml:lang="gl">$2<\/foreign>/g; #Victor
   	$text =~ s/\[gallego:\s*([^\]]+)\]/<foreign xml:lang="gl">$1<\/foreign>/g; #Victor
   	$text =~ s/\[galego:\s*([^\]]+)\]/<foreign xml:lang="gl">$1<\/foreign>/g; #Victor
   	$text =~ s/\[cat(\.|):\s*([^\]]+)\]/<foreign xml:lang="ca">$2<\/foreign>/g; #Victor
   	$text =~ s/\[catal&#xE1;n:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
	$text =~ s/\[catalán:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
   	$text =~ s/\[catal&#xE0;:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
	$text =~ s/\[català:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
   	$text =~ s/\[catala:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
   	$text =~ s/\[catalan:\s*([^\]]+)\]/<foreign xml:lang="ca">$1<\/foreign>/g; #Victor
	$text =~ s/\[fra(\.|):\s*([^\]]+)\]/<foreign xml:lang="fr">$2<\/foreign>/g;
   	$text =~ s/\[franc&#xE9;s:\s*([^\]]+)\]/<foreign xml:lang="fr">$1<\/foreign>/g; #Victor
	$text =~ s/\[francés:\s*([^\]]+)\]/<foreign xml:lang="fr">$1<\/foreign>/g; #Victor
   	$text =~ s/\[frances:\s*([^\]]+)\]/<foreign xml:lang="fr">$1<\/foreign>/g; #Victor
	$text =~ s/\[fr(\.|):\s*([^\]]+)\]/<foreign xml:lang="fr">$2<\/foreign>/g; #Victor
	$text =~ s/\[ing(\.|):\s*([^\]]+)\]/<foreign xml:lang="en">$2<\/foreign>/g; #Victor
   	$text =~ s/\[ingl&#xE9;s:\s*([^\]]+)\]/<foreign xml:lang="en">$1<\/foreign>/g; #Victor
	$text =~ s/\[inglés:\s*([^\]]+)\]/<foreign xml:lang="en">$1<\/foreign>/g; #Victor
   	$text =~ s/\[ingles:\s*([^\]]+)\]/<foreign xml:lang="en">$1<\/foreign>/g; #Victor
	$text =~ s/\[en(\.|):\s*([^\]]+)\]/<foreign xml:lang="en">$2<\/foreign>/g; #Victor

   	
   	#sic and enmienda
   	$text =~ s/\[sic:\s*([^\]]+)\]/<sic>$1<\/sic>/g;
   	$text =~ s/\[enmienda:\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<sic>$1\|\=$2<\/sic>/g; #Victor
   	
   	
   	#cancelations (del)
   	$text =~ s/\[tachado:\s*([^\]]+)\]/<del type="tachado">$1<\/del>/g; #Victor
	$text =~ s/\[cancelado:\s*([^\]]+)\]/<del type="cancelado">$1<\/del>/g; #Victor
	$text =~ s/\[borrado:\s*([^\]]+)\]/<del type="borrado">$1<\/del>/g; #Victor
   	$text =~ s/\[raspado:\s*([^\]]+)\]/<del type="raspado">$1<\/del>/g; #Victor
   	$text =~ s/\[sub\s*puntuado:\s*([^\]]+)\]/<del type="subpuntuado">$1<\/del>/g; #Victor
   	$text =~ s/\[tachado mano\s*(\d):\s*([^\]]+)\]/<del type="tachado" hand="#h$1">$2<\/del>/g; #Victor
	$text =~ s/\[cancelado mano\s*(\d):\s*([^\]]+)\]/<del type="cancelado" hand="#h$1">$2<\/del>/g; #Victor
	$text =~ s/\[borrado mano\s*(\d):\s*([^\]]+)\]/<del type="borrado" hand="#h$1">$2<\/del>/g; #Victor
   	$text =~ s/\[raspado mano\s*(\d):\s*([^\]]+)\]/<del type="raspado" hand="#h$1">$2<\/del>/g; #Victor
	# $text =~ s/\[sobre raspado mano\s*(\d):\s*([^\]]+)\]/<del type="sobreRaspado" hand="#h$1">$2<\/del>/g; #Victor
   	# $text =~ s/\[sobrerraspado mano\s*(\d):\s*([^\]]+)\]/<del type="sobreRaspado" hand="#h$1">$2<\/del>/g; #Victor
   	$text =~ s/\[subpuntuado mano\s*(\d):\s*([^\]]+)\]/<del type="subpuntuado" hand="#h$1">$2<\/del>/g; #Victor
   	
   	#additions (add)
   	$text =~ s/\[a&#xF1;adido:\s*([^\]]+)\]/<add>$1<\/add>/g;
	$text =~ s/\[añadido:\s*([^\]]+)\]/<add>$1<\/add>/g;
   	$text =~ s/\[interlineado:\s*([^\]]+)\]/<add place="interlineado">$1<\/add>/g;
   	$text =~ s/\[margen:\s*([^\]]+)\]/<add place="margen">$1<\/add>/g;
   	$text =~ s/\[margen izquierdo:\s*([^\]]+)\]/<add place="margen izquierdo">$1<\/add>/g;
   	$text =~ s/\[margen derecho:\s*([^\]]+)\]/<add place="margen derecho">$1<\/add>/g;
	$text =~ s/\[margen superior:\s*([^\]]+)\]/<add place="margen superior">$1<\/add>/g;
	$text =~ s/\[margen inferior:\s*([^\]]+)\]/<add place="margen inferior">$1<\/add>/g;
	$text =~ s/\[sobre:\s*([^\]]+)\]/<add place="sobre">$1<\/add>/g; #Víctor
   
   	#additions (add) + other hand
   	$text =~ s/\[a&#xF1;adido mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1">$2<\/add>/g;
	$text =~ s/\[añadido mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1">$2<\/add>/g;
   	$text =~ s/\[interlineado mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="interlineado">$2<\/add>/g;
   	$text =~ s/\[margen mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="margen">$2<\/add>/g;
   	$text =~ s/\[margen izquierdo mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="margen izquierdo">$2<\/add>/g;
   	$text =~ s/\[margen derecho mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="margen derecho">$2<\/add>/g;
	$text =~ s/\[margen inferior mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="margen inferior">$2<\/add>/g;
	$text =~ s/\[margen superior mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="margen superior">$2<\/add>/g;
	$text =~ s/\[sobre mano\s*(\d):\s*([^\]]+)\]/<add hand="#h$1" place="sobre">$2<\/add>/g;
   
   	#substitutions (subst)
    $text =~ s/\[sobrescrito:\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobrescrito">$1<\/del><add type="sobrescrito">$2<\/add><\/subst>/g;
   	$text =~ s/\[sobrescrito:\s*([^\]]+)\]/<subst><del type="sobrescrito"\/><add type="sobrescrito">$1<\/add><\/subst>/g;
   	$text =~ s/\[sobrescrito mano\s*(\d):\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobrescrito">$2<\/del><add type="sobrescrito" hand="#h$1">$3<\/add><\/subst>/g;
   	$text =~ s/\[sobrescrito mano\s*(\d):\s*([^\]]+)\]/<subst><del type="sobrescrito"\/><add type="sobrescrito" hand="#h$1">$2<\/add><\/subst>/g;
   	
   	$text =~ s/\[sobre\s*raspado:\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobreRaspado">$1<\/del><add type="sobreRaspado">$2<\/add><\/subst>/g;
	$text =~ s/\[sobrerraspado:\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobreRaspado">$1<\/del><add type="sobreRaspado">$2<\/add><\/subst>/g;
   	$text =~ s/\[sobre\s*raspado:\s*([^\]]+)\]/<subst><del type="sobreRaspado"\/><add type="sobreRaspado">$1<\/add><\/subst>/g;
	$text =~ s/\[sobrerraspado:\s*([^\]]+)\]/<subst><del type="sobreRaspado"\/><add type="sobreRaspado">$1<\/add><\/subst>/g;
   	$text =~ s/\[sobre\s*raspado mano\s*(\d):\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobreRaspado">$2<\/del><add type="sobreRaspado" hand="#h$1">$3<\/add><\/subst>/g;
	$text =~ s/\[sobrerraspado mano\s*(\d):\s*([^\]\+]+)\s*\+\s*([^\]]+)\]/<subst><del type="sobreRaspado">$2<\/del><add type="sobreRaspado" hand="#h$1">$3<\/add><\/subst>/g;
   	$text =~ s/\[sobre\s*raspado mano\s*(\d):\s*([^\]]+)\]/<subst><del type="sobreRaspado"\/><add type="sobreRaspado" hand="#h$1">$2<\/add><\/subst>/g;
	$text =~ s/\[sobrerraspado mano\s*(\d):\s*([^\]]+)\]/<subst><del type="sobreRaspado"\/><add type="sobreRaspado" hand="#h$1">$2<\/add><\/subst>/g;
   	
   	#handShift
   	$text =~ s/\[mano\s*(\d):\s*([^\]]+)\]/<handShift resp="\#h$1">$2<\/handShift>/g;
   	
   	#firma y rúbrica
   	$text =~ s/\[firma:\s*([^\]]+)\]/<signed>$1<\/signed>/g;
   	$text =~ s/\[firma mano\s*(\d):\s*([^\]]+)\]/<signed hand="#h$1">$2<\/signed>/g;
   	$text =~ s/\[firma en ([^:]+):\s*([^\]]+)\]/<signed xml:lang="$1">$2<\/signed>/gi;
   	$text =~ s/\[firma en ([^\]]+)\]/<signed xml:lang="$1"\/>/gi;
   	$text =~ s/\[r&#xFA;brica\]/<figure type="rúbrica"\/>/g;
	$text =~ s/\[rúbrica\]/<figure type="rúbrica"\/>/g;
   	$text =~ s/\[r&#xFA;brica:\s*([^\]]+)\]/<figure type="rúbrica">$1<\/figure>/g;
	$text =~ s/\[rúbrica:\s*([^\]]+)\]/<figure type="rúbrica">$1<\/figure>/g;
   	
   	#div
   	$text =~ s/\[encabezamiento:\s*([^\]]+)\]/<div type="encabezamiento">$1<\/div>/g;
   	$text =~ s/\[t&#xED;tulo:\s*([^\]]+)\]/<div type="título">$1<\/div>/g;
	$text =~ s/\[título:\s*([^\]]+)\]/<div type="título">$1<\/div>/g;
   	$text =~ s/\[encabezamiento mano\s*(\d):\s*([^\]]+)\]/<div hand="$1" type="encabezamiento">$2<\/div>/g;
   	$text =~ s/\[t&#xED;tulo mano\s*(\d):\s*([^\]]+)\]/<div hand="$1" type="título">$2<\/div>/g;
	$text =~ s/\[título mano\s*(\d):\s*([^\]]+)\]/<div hand="$1" type="título">$2<\/div>/g;
	$text =~ s/\[bajo la plica:\s*([^\]]+)\]/<div type="bajo la plica">$1<\/div>/g;
	$text =~ s/\[rueda:\s*([^\]]+)\]/<div type="rueda">$1<\/div>/g;
   	
   	#recover XML tags created in TEITOK
#    	$text =~ s/&lt;/</g;
#    	$text =~ s/&gt;/>/g;
   	
   	#escape ampersand
   	$text =~ s/ \& / \&amp; /g;
   	$text =~ s/ \&c / \&amp;c /g;
   
   
$xml = $before.$text.$after;
   
# Now - check if this turned into valid XML
$parser = XML::LibXML->new(); $doc = "";
eval {
	$doc = $parser->load_xml(string => $xml);
};
if ( !$doc ) { 
	print "XML got messed up - saved to /tmp/wrong.xml\n"; 
	open FILE, ">/tmp/wrong.xml";
	# binmode ( FILE, ":utf8" );
	print FILE $xml;
	close FILE;
	
	$err = `xmlwf /tmp/wrong.xml`;
	if ( $err =~ /^(.*?):(\d+):(\d+):/ ) {
		$line = $2; $char = $3;
		print "First XML Error: $err";
		print `cat /tmp/wrong.xml | head -n $line | tail -n 1`;
	};
	
	exit; 
};

# Finally, produce the output
if ( $test ) { 

	# Just print when testing
	print  $xml;

} else {

	# Make a backup of the file
	( $buname = $filename ) =~ s/xmlfiles.*\//backups\//;
	$date = strftime "%Y%m%d", localtime; 
	$buname =~ s/\.xml/-$date.charta.xml/;
	$cmd = "/bin/cp $filename $buname";
	`$cmd`;

	open FILE, ">$filename";
	binmode (FILE, ":utf8");
	print FILE $xml;
	close FILE;

	print "Document converted to TEI/XML (CHARTA 3.0)";
};
