#!/usr/bin/perl

# Best-viewed with a tab size of 2 spaces (:set tabstop=2 in vi)
# #}, #{, #( and #) comments used for correct parenthesis match in vi.

use strict;
use locale;
use XML::DT;

=head1 NAME

bb2tex - Tradutor do Bullarium Bracarense de XML para LaTeX.

=cut

=head1 SINOPSE

B<bb2tex> bb.xml

=cut

=head1 DESCRIPTION

B<bb2tex> recebe uma implementação da I<linguagem BB>,
i.e., uma instância da gramática definida pelo B<DTD>
do Bullarium Bracarense (F<bb.dtd>), e gera,
para o standard output, um correspondente documento LaTeX.

B<bb2tex> faz uso do melhor módulo Perl de processamento de
informação XML, o B<XML::DT>.

=cut

$ENV{'LC_CTYPE'} = 'pt_PT';	# necessário para a função sort

$\ = "\n";									# separador de saída de registo

# ficheiro a processar: $ARGV[0]
(my $xmlfile = shift) or die ("Sintaxe: bb2tex bb.xml\n");

my $header = "";	# cabeçalho da bula
my $who = "";			# emissor da bula (1)
my $whom = "";		# um destinatário da bula
my $whoms = "";		# destinatários da bula (2)
my $content = "";	# conteúdo da bula
my $linkage;			# conectivo de ligação (1)-(2)
my $idxitem = 0;	# contador $idxitem (p/ lista enumerada após intro)
my $architem = 0;	#	contador $architem (usado nas refs manuscritas)
my $current_bula_id = "B1"; # id da bula

my %anthropos;		# ff de pessoas (p/ índice antroponimico)
my %topos;				# ff de lugares (p/ índice toponímico)
my %geotopos;			# ff de info geo de lugares (aux de %topos)
my %addgeotopos;	# ff de info adicional geo lugares (aux de %geotopos)
my $agglen = 3;		# comprimento mínimo de lista de números consectivos
									# para q se crie uma abreviatura desses números
									# Ex.: 1, 2, 3 -> 1 a 3; 51, 52, 53, 54 -> 51 a 54
									# (p/ índices)

my $bulavsp = "12pt";			# espaço vertical entre bulas
my $bulahdrvsp = "6pt";		# espaço vertical entre bula e header,
													# i.e. entre a linha do id da bula
													# e a do bloco que contem who e whom
my $tabcapvsp = "12pt";		# espaço vertical entre as tabelas e os
													# seus títulos do quadro sincrónico
my $cntqtedvsp = "6pt";		# espaço vertical entre contents e addon
my $trfbulavsp = "12pt";	# espaço vertical entre bulas transferidas

# carregamento da lista de apelidos referentes
# a nomes que não # respeitam a REGRA 1 (=head2 REGRA 1)
my %anthropos_spnames =	&load_anthspnames;

my %rmnarb = (	'I' => 1, 'V' => 5, 'X' => 10, 'L' => 50,
						'C' => 100, 'D' => 500, 'M' => 1000
					);

my %arbrmn = (	1 => 'I', 5 => 'V', 10 => 'X', 50 => 'L',
						100 => 'C', 500 => 'D', 1000 => 'M'
					);

sub ssort {

	my $chars = '[A-Za-zÀÁÂÃÈÉÊÌÍÎÒÓÔÕÙÚÛàáâãèéêìíîòóôõùúûÇç ]+';

	my $o1 = ($a =~ /^($chars)? ([IVX]+) --- .*$/); my $x1 = $1, my $x2 = $2;
	my $o2 = ($b =~ /^($chars)? ([IVX]+) --- .*$/); my $y1 = $1, my $y2 = $2;

	if ($o1 && $o2 && ($x1 eq $y1)) {
		((&arabic ($x2)) <=> (&arabic ($y2)));
	}
	else {
		$a cmp $b;
	}

} # end of ssort

sub arabic {
	my $x = shift;
	$x =~ s/([IVXLCDM])(\1*)/$rmnarb{$1}*((length $2)+1).' '/ge;
	my @x = split / /, $x;
	while ((scalar @x) > 1) {
		my $y = ($x[$#x] > $x[$#x-1]) ? $x[$#x] - $x[$#x-1] : $x[$#x] + $x[$#x-1];
		splice @x, $#x-1, 2, $y;
	}
	join (" ", @x);
} # end of arabic

sub roman {
	my $arabic = shift;
	my $roman;
	my ($excep_roman, $remainder) = ('', 0);
	if ($arabic > 0) {
		($excep_roman, $remainder) = @{&ranged ($arabic)};
		if ($excep_roman ne '') {
			$roman .= $excep_roman . &roman ($remainder);
		}
		else {
			my $denom = &nearest ($arabic);
			my $division = $arabic / $denom;
			my $roman .= ($arbrmn{$denom}) x $division . &roman ($arabic % $denom);
		}
	}
	else { '';	}
} # end of roman

=head1 ESTRUTURAS DE DADOS

=over

=item B<%dthandler> Array associativo que a função
I<XML::DT::dtstring> recebe.

=item B<%anthropos_spnames> Array associativo que
contem a lista de apelidos --- dos nomes passíveis
de surgirem como items no índice toponímico ---
que não seguem a I<Regra 1> (ver Índice Antroponímico/Regra 1).

=item B<%anthropos> Array associativo que relaciona nomes de pessoas
a 'papéis' (roles) que elas tomam e, por sua vez, associa estes
a bulas que as referenciam (ver Índice Antroponímico).

=item B<%topos> Array associativo que relaciona nomes de cidades,
vilas, etc. a lugares e, por sua vez, a bulas em que elas ocorrem
(ver Índice Toponímico).

=item B<%geotopos> Array associativo que contem informação geográfica
específica para cada cidade, vila, etc. (ver Índice Toponímico).

=item B<%addgeotopos> Array associativo que contem informação
geográfica adicional para cada cidade, vila, etc.
(ver Índice Toponímico)

=back

=cut

my %dthandler = (

'-outputenc'		=>	'ISO-8859-1',

#-default				=>	sub {	$c;							},
# i'd rather specify elements, one by one.

-type						=>	{},

bulario					=>
	sub {
		$c =	&startLaTeX .
		&bbFrontPage .
		"\n" . "\\pagestyle{empty}" . "\n" .
		&tableOfContents .
		"\n" . "\\pagestyle{empty}" . "\n" .
		$c;	
	},

intro						=>
	sub {
		"\\bbchapter{$v{title}}" . "\n" .
		'% Restore fancy page styling:' . "\n" .
		"\\pagestyle{fancy}" . "\n\n" .
		$c;
	},

quotation				=>
	sub	{
		'\begin{quotation}'."\n".'\small'."\n".$c.
		"\n\n\\hfill($v{author}, $v{title}, $v{local}, ".
		"$v{year}, p. $v{page})\n".
		'\end{quotation}'.
		"\n\n";
	},

block						=>
	sub	{	"$c\n\n";																	},

idxlist					=>
	sub	{	'\begin{enumerate}'.$c.'\end{enumerate}';	},

idxitem					=>
	sub	{
		(($idxitem++ > 0) ?
			&item_separator :
			""
		) .
		'\item '.$c;	
	},

synctable				=>
	sub	{	"\\newpage\n\\bbchapter{$v{title}}".$c;		},

archbishops					=>
	sub	{
		"\\begin{center}" . "\n" .
		"\\textsc{\\Large $v{title}}" . "\n" .
		"\\end{center}" . "\n" .
		"\\vspace{$tabcapvsp}" .
		$c .
		"\n\n" .
		'% start archbishops list in a new page:' . "\n" .
		"\\pagebreak" .
		"\n\n";
	},

archbishop					=>
	sub	{	&mk_time (\%v) . "\\dotfill" . $c;				},

popes						=>
	sub	{
		"\\begin{center}" . "\n" .
		"\\textsc{\\Large $v{title}}" .  "\n" .
		"\\end{center}" . "\n" .
		"\\vspace{$tabcapvsp}" .
		$c .
		"\n\n";
	},

pope						=>
	sub	{	&mk_time (\%v) . "\\dotfill" . $c;				},

bibsiglas				=>
	sub	{	"\\newpage\n\\bbchapter{$v{title}}\n$c";	},

printedrefs			=>
	sub	{
		"\\bbsection{$v{title}}\n".
		"\\begin{description}\n".
		$c.
		"\\end{description}\n";										
	},

printedref			=>
	sub	{
		chomp ($v{year});
		$v{year} =~ s/\n//;
		chomp ($c);
		$c .= $v{year};													
	},

author					=>
	sub	{	$c  =~ s/\n//g; chomp ($c); "\\item [$c]";	},

docname					=>
	sub	{ chomp ($c); $c  =~ s/\n//g; $c; },

hwrittenrefs		=>
	sub	{
		"\\newpage\n\\bbsection{$v{title}}\n".
		$c;																		
	},

hwrittenrefset	=>
	sub {
		(($architem++ > 0) ?
		&item_separator :
		""
		) .  
		"\\ubbsubsection{$v{archive}}\n".
		"\\begin{itemize}$c\\end{itemize}\n";
	},

hwref						=>
	sub	{	$c =~ s/\n//;	'\item ' . $c;							},

abbsiglas				=>
	sub {
		"\\newpage\n\\bbsection{$v{title}}\n" .
		"\\begin{description}\n".
		$c . "\\end{description}\n";						
	},

abbsigla				=>
	sub	{	chomp ($c); "\\item $c"; },

abb							=>
	sub	{	chomp ($c);	"[$c]";			},

sigla						=>
	sub	{	chomp ($c); $c;					},

summaries				=>
	sub	{	"\\newpage\n\\bbchapter{$v{title}}\n$c";},

century					=>
	sub	{
		"\\ubbsection{$v{title} $v{century}}".
		"\n".
		$c;																		
	},

bula						=>
	sub	{
		$current_bula_id = $v{id};
		&bula_id ($current_bula_id) . "\\hfill".
		&bula_space_and_time (\%v).
		"\\hfill" .
		"\n\n" .
		"\\nopagebreak" .
		"\n" .
		"\\vspace{$bulahdrvsp}" .
		"$header --- ".
		"\\mbox{".($v{role} or "BULA")."}".
		" ".
		$content .
		$c;
	},

header					=>
	sub	{
		$header = "$who $linkage $whoms.";
		undef $whoms;	# reset $whoms
		"";
	},

who							=>
	sub	{
		$who = $c;
		$linkage = (defined $v{link}) ? $v{link} : ' a ';
		"";
	},

whom						=>
	sub	{
		chomp ($c);
		$whoms .= $c;
		if (defined $v{link}) {
			chomp ($v{link});
			$whoms .= (($v{link} =~ /^,/) ? '' : ' ') .  $v{link} .  ' ';
		}
		"";
	},

content					=>
	sub	{	$content = &trim ($c); "";							},

addon						=>
	sub	{
		"\n" . "\\vspace{$cntqtedvsp}" . "\n" .
		"\\begin{footnotesize}" .
		$c .
		"\\end{footnotesize}" .
		"\n\\vspace{$bulavsp}\n";									
	},

quoted					=>
	sub	{	"``" . &trim ($c) . "''\n\n";						},

library					=>
	sub	{
		chomp ($v{name});
		"$v{name} --- $c\n\n";
	},

publ						=>
	sub	{
		chomp ($c);
		"PUBL.: $c" . "\n\n";
	},

ref							=>
	sub	{
		chomp ($c);
		"REF.: $c" . "\n\n";
	},

note						=>
	sub	{
		chomp ($c);
		"NOTA: $c" . "\n\n";
	},

appendix				=>
	sub	{
		$v{title} =~ s/\n//g;
		"\\newpage" .
		"\\ubbsection{$v{title}}" .
		"\n\n" .
		$c;
	},

subtitle				=>
	sub	{
		$c =~ s/\n//g;
		"\\ubbsubsection{$c}" . "\n\n";
	},

transfbulas			=>
	sub	{
		"\n\\vspace{12pt}\n" .
		$c.
		"\n\n";
	},

transfbula			=>
	sub	{
		chomp ($v{id});
		chomp ($v{year});
		chomp ($v{eyear});
		$c =~ s/\n//g;
		"$v{id} --- $c" . 
		"\\nolinebreak " .
		" \\hfill " .
		((not defined $v{year}) ?
			'$\cdots\cdots$' :
			(($v{year} and $v{eyear}) ?
				"\\textbf{$v{year}} ou \\textbf{$v{eyear}}" :
				"\\textbf{$v{year}}")) .
		"\n\\vspace{$trfbulavsp}\n";
	},

anthropos				=>
	sub	{
		chomp ($c);
		chomp ($v{role});
		my $whopos =
			(defined $v{fullname}) ?
			(chomp ($v{fullname}), &prepstr ($v{fullname})) :
			&prepstr ($c);
		$v{role} = &prepstr ($v{role});
		push (@{$anthropos{$whopos}{$v{role}}},
					&bula_id ($current_bula_id) + 1);
		$c;																		
	},

topos						=>
	sub	{
		chomp ($c);
		chomp ($v{name});
		chomp ($v{role});
		chomp ($v{geoinfo});
		my $wherepos =
			(defined $v{contents}) ?
			(chomp ($v{contents}), uc ($v{contents})) :
			uc ($c);
		$v{role} = &prepstr ($v{role});
		push (@{$topos{$wherepos}{$v{role}}},
					&bula_id ($current_bula_id) + 1);
		$geotopos{$wherepos} = $v{geoinfo}
			if ((!exists $geotopos{$wherepos}) &&
					(exists $v{geoinfo}) &&
					($v{geoinfo} ne ''));
		$addgeotopos{$wherepos} = $v{name}
			if ((!exists $addgeotopos{$wherepos}) &&
					(exists $v{name}) &&
					($v{name} ne ''));
		$c;																		
	},

-end						=>
	sub	{
		# pq a função I<anthropos> desordena os nomes das pessoas
		# (devido à aplicação da regra 1),
		# é necessário reordenar o seu resultado:
		$c .
		&anthroposIndexHeader .
		join ("\n\n", &apply_initials
										(sort ssort (split (/\n/, &anthropos)))) .
		&toposIndexHeader .
		join ("\n\n", &apply_initials (sort (split (/\n/, &topos)))) .
		&endLaTeX;
	},

); # end of %dthandler structure

=head1 ÍNDICES

B<bb2tex> gera automaticamente os índices toponímico e
antroponímico do Bullarium Bracarense.

=head2 Índice Antroponímico

A lista de apelidos pertencentes a items do índice
antroponímico que não seguem a I<REGRA 1> é carregada
para o array associativo B<%anthropos_spnames>.

I<Regra 1>

Seja Nome = <word[1] ... word[n]> um nome de uma pessoa,
a sua representação como item do índice antroponímico será:

"uc (word[n]), word[1] ... word[n-1]",

sendo I<uc> a função em Perl que, para uma dada string,
devolve uma nova em que todos os seus caracteres
estão em maiúsculas.

Por exemplo, a representação no índice toponímico de

I<Fernando de Azevedo Coutinho de Vasconcelos>

é

I<VASCONCELOS, Fernando de Azevedo Coutinho de>.

NB: De referir que não é necessário incluir nesta lista nomes
do tipo "CLEMENTE III", uma vez que todos os que seguem
esta forma - terminados em letras romanas - são já tratados de forma
especial.

Os elementos XML I<anthropos> são os que populam as estruturas
supra-citadas:

	<!ELEMENT anthropos (#PCDATA)  >
	<!ATTLIST anthropos  
	fullname CDATA #IMPLIED
	role CDATA #IMPLIED >

Como exemplo, tomem-se o seguinte elemento:

	<anthropos fullname="Vasco Martins" role="bispo do Porto">
	Vasco
	</anthropos>

A informação antroponímica (relativa a pessoas)
é guardada na seguinte estrutura:

 %anthropos = (
   'inocencio' => { 'bispo'  => [1, 2, 3, 4, 5],
                    'papa'  => [6, 7, 8, 9, 10],
                    'arcebispo' => [6, 7, 8, 9, 10],
                    ''   => [5, 6],
  },
  'clemente'   => { 'arcebispo' => [1, 2, 3, 6, 7, 9, 10],
                    'papa'  => [6, 7, 8],
                    ''   => [5, 6],
                  },
 );

A cada pessoa associa-se um conjunto de "papéis" (roles)
e a cada um destes "papéis" faz-se corresponder um conjunto
de bulas que os referenciam.

=head2 Índice Toponímico

A informação toponímica (relativa a lugares),
é guardada em duas estruturas:

I<%topos> and I<%geotopos>.

O array associativo I<%topos> comporta, como suas chaves,
os nomes de cidades, vilas, etc. (1), enquanto que o seu
contradomínio é uma outra função finita que relaciona
lugares específicos de (1) a um conjunto de bulas
onde eles são referidos.

Exemplo:

 %topos = (
   'Monção' => { 'convento'  => [1, 2, 3, 4, 5],
                 'mosteiro de S. Francisco' => [6, 7, 8, 9, 10],
               },
   'Braga'  => { 'Bom Jesus'  => [21, 52, 63, 74, 85],
                     ...      => [...],
               },
     ...
 );

O array associativo I<%geotopos> contem, para um subconjunto
do domínio de I<%topos>, informação geográfica específica.

Exemplo:

 %geotopos  = ( 'Monção'   => 'v., c. d. Viana do Castelo',
                  ...      =>          ...           
              );

O array associativo I<%addgeotopos> contem, para um subconjunto
do domínio de I<%geotopos>, informação geográfica adicional.

 %addgeotopos  = ( 'Adaúfe'   => 'Sta. Maria',
                 		...       =>     ...           
              );

Os elementos XML I<topos> são os que populam as estruturas
supra-citadas:

	<!ELEMENT topos (#PCDATA)  >
	<!ATTLIST topos  
	name CDATA #IMPLIED
	role CDATA #IMPLIED
	geoinfo CDATA #IMPLIED >

Como exemplo, tomem-se os seguintes elementos:

 <topos role="convento" geoinfo="v., c. d. Viana do Castelo">
 Monção
 </topos>

 <topos role="mosteiro de S. Francisco">
 Monção
 </topos>

 <topos name="St. Maria" role="monge do mosteiro"
 				geoinfo="fr., c. e d. Braga">
 Adaúfe
 </topos>

De referir que os valores dos atributos I<geoinfo> e I<name>
de um determinado elemento I<topos> são herdados para os
elementos que a ele se seguem. Por exemplo, no exemplo acima,
o segundo elemento herda o valor do atributo I<geoinfo> do
primeiro elemento.

Para efeitos de processamento do Bullarium Bracarense, considera-se
a inexistência do atributo I<role> num elemento I<topos>
como sendo igual à existência daquele atributo com valor vazio.

Ou seja,

 <topos>
 Monção
 </topos>

é equivalente a

 <topos role="">
 Monção
 </topos>

=cut

=head1 FUNÇÕES

=head2 B<prepstr>

A função I<prepstr> prepara uma dada string para inserção
na estrutura I<%anthropos> ou I<%topos>.
Eis uma série de imagens da função para um conjunto finitos de nomes
de pessoas
(as linhas a B<bold> são aquelas para as quais a função devolve
um valor de saída diferente do de entrada):

=over

=item prepstr ('Clemente') = 'Clemente'

=item B<prepstr ('CLEMENTE') = 'Clemente'>

=item prepstr ('dos') = 'dos'

=item prepstr ('sOARES') = 'sOARES'

=item prepstr ('sOARes') = 'sOARes'

=item B<prepstr ('Alexandre III') = 'ALEXANDRE III'>

=item prepstr ('ALEXANDRE III') = 'ALEXANDRE III'

=back

	

=cut

sub prepstr {

	my $ppred = shift;
	my $prepstr;
	my @prepwords = split (/ +/, $ppred);

	if ($prepwords[$#prepwords] =~ /^[IVX]+$/) {
		$prepstr = uc ($ppred);
	}
	else {
		my $ii = 0;
		my $iimax = scalar @prepwords;
		for ($ii = 0; $ii < $iimax; $ii++) {
			my $iielem = $prepwords[$ii];
			$prepwords[$ii] = ucfirst (lc ($prepwords[$ii]))
				if (($iielem eq (uc ($iielem))) and ($iielem !~ /[IVX]+/));
		}
		$prepstr = join (" ", @prepwords);
	}
	$prepstr;

} # end of sub prepstr

=head2 B<apply_initials>

A função I<apply_initials> recebe uma referência
para uma lista de entradas de um índice a adiciona-lhe
as iniciais (A, B, C...) antes da sublista de entradas
correspondentes.

=cut

sub apply_initials {

	my @unapplied = @_;
	my @applied = ();
	my $entry;
	my $current_letter = substr ($unapplied[0], 0, 1);
	push (@applied, &mkiinitial ($current_letter));

	for $entry (@unapplied) {
		my $first_letter = substr ($entry, 0, 1);
		if (($first_letter ne $current_letter) and
				($first_letter =~ /[A-Z]/)) {
			$current_letter = $first_letter;
			push (@applied, &mkiinitial ($current_letter));
		}
		push (@applied, $entry);
	}
	@applied;

} # end of sub apply_initials

=head2 B<mkiinitial>

A função I<mkiinitial> recebe uma inicial e
devolve uma string LaTeX com a inicial centrada e estilizada
(função auxiliar de I<apply_initials>).

=cut

sub mkiinitial {

	"\\begin{center}" . "\n" .
		"\\textsc{\\textbf{" . (shift) . "}}" . "\n" .
		"\\end{center}" . "\n" .
		"\\nopagebreak";

} # end of sub mkinitial

my $bulario = dtstring (&pre_process ($xmlfile), %dthandler);

print $bulario;

=pod

A função I<anthropos> constrói o Índice Antroponímico.

Devolve uma string da forma:

"APELIDO, Nome --- role, docs. x, y a z

APELIDO, Nome --- docs. x, y a z

APELIDO, Nome --- role, doc. x

..."

=cut

sub anthropos {

	my %roles;
	my @docs;
	my $return_value = "";

	foreach (sort keys %anthropos) {
		my $hwho = $_;
		%roles = %{$anthropos{$hwho}};
		local ($\ = "");
		foreach (sort keys %roles) {
			my $a_role = $_;
			$return_value .= &mkname ($hwho);
			$return_value .= " --- ";
			@docs = @{$roles{$_}};
			# se a pessoa for apenas referida numa bula,
			# usa-se 'doc.', senao usa-se 'docs.':
			my $doc_or_docs = ((scalar @docs) == 1) ? 'doc.' : 'docs.';
			$return_value .=
				($a_role ne '') ?
				'\textit{' . $a_role . '}, ' .	' ' . $doc_or_docs . ' ' :
				' ' . $doc_or_docs . ' ';
			$return_value .= join (", ", &bsort (@docs)) . ".\n";
		}
	}

	$return_value;

} # end of sub anthropos

=head2 B<topos>

A função I<topos> constrói o Índice Toponímico.

=cut

sub topos {
	
	my %roles;
	my @docs;
	my $return_value = "";

	foreach my $hwhere (sort keys %topos) {
		%roles = %{$topos{$hwhere}};
		local ($\ = "");
		$return_value .= $hwhere;
		$return_value .= " --- ";
		$return_value .= $addgeotopos{$hwhere} . ' '
												if exists $addgeotopos{$hwhere};
		$return_value .= '[' . $geotopos{$hwhere} . ']' . ': '
			if exists $geotopos{$hwhere};
		my $rcounter = 1;	my $rmaxcounter = scalar keys %roles;
		# a ordenação dentro do mesmo topos está a ser feita por
		# ordem alfabética ascendente dos nomes das roles;
		# caso se desejasse ordenar numericamente as bulas tendo em
		# conta as diferentes roles dentro do mesmo lugar:
		# foreach (sort {$roles{$a}[0] <=> $roles{$b}[0]} keys %roles) {
		#}
		foreach (sort keys %roles) {
			my $a_role = $_;
			@docs = @{$roles{$_}};
			# se o lugar for apenas referido numa bula,
			# usa-se 'doc.', senao usa-se 'docs.':
			my $doc_or_docs = ((scalar @docs) == 1) ? 'doc.' : 'docs.';
			$return_value .=
				($a_role ne '') ?
					'\textit{' . $a_role . '}, ' .	' ' . $doc_or_docs . ' ' :
																				' ' . $doc_or_docs . ' ';
			$return_value .= join (", ", &bsort (@docs));
			$return_value .= ($rcounter++ == $rmaxcounter) ? ".\n" : "; ";
		}
	}

	$return_value;

} # end of sub topos

=head2 B<mkname>

A função I<mkname> devolve uma representação apropriada
para o nome de uma pessoa para inclusão no índice antroponímico,
ou seja, para um dado nome, aplica a I<Regra 1>.

=cut

sub mkname {

	my $names = shift;
	chomp ($names);
	my $anames = "";
	my $z = 0;
	my @spnames = keys %anthropos_spnames;

	# if a name ends with one of the surnames
	# defined in %anthropos_spnames...
	for ($z = 0; $z <= $#spnames && ($anames eq ""); $z++) {
		my $sp = $spnames[$z];
		if ($names =~ /(.*?)$sp/i) {
			# for example, for "Afonso Castelo Branco",
			# $anames will be "CASTELO BRANCO, Afonso"
			$anames = uc ($sp) . (($1 ne '') ? ', ' . $1 : '');
		}
	}

	# if $anames doesn't end with one of the surnames
	# defined in %anthropos_spnames...
	if ($anames eq "") {
		# first, split up its words...
		my @names = split (/ +/, $names);
		# then check if they end in roman, like,
		# for instance, "Calisto III":
		if ($names[$#names] =~ /^[IVX]+$/) {
			# if something like 'CLEMENTE VI', then simply upcase it:
			$anames = uc (join (" ", @names));
		}
		# if it doesn't end in roman and #words > 1,
		# then swap surname with rest of words:
		elsif ((scalar @names) > 1) {
			$anames = uc ($names[$#names]) .
								', ' .
								(join (' ', @names[0..$#names-1]));
		}
		# finally, if number of words is just 1,
		# simply upcase it:
		else {
			$anames = uc ($names);
		}
	}
	
	$anames;

} # end of sub mkname

=head2 B<bsort>

A função I<bsort> recebe um array de números de bulas e
devolve uma sua forma abreviada.

Ex.: bsort (1, 2, 5, 6, 7, 101) = (1, 2, "5 a 7", 101)

=cut

sub bsort {

	local $, = ', ';
	my @docs = &remove_repeated (sort {$a <=> $b} @_);

	my @bsdocs = ();

	my $i = 0;
	my $bsdocslen = 1;

	# if length of @docs is greater or equals than $arrlen,
	# then one'll try to abbreviate it...
	if ((scalar @docs) >= $agglen) {
		# initialize @bsdocs with first element in
		# array of sequence of document numbers...
		@bsdocs = $docs[$i];
		while ($i < $#docs) {
			# if consecutive numbers
			if ($docs[$i] == $docs[$i+1]-1) {
				push (@bsdocs, $docs[$i+1]);
				# increase length of sublist of consecutive numbers
				$bsdocslen++;
			}
			# if no consecutive numbers
			else {
				# if it's worthy to abbreviate, then do it:
				if ($bsdocslen >= $agglen) {
					splice (@bsdocs,
									$#bsdocs + 1 - $bsdocslen,
									$bsdocslen,
									"$docs[$i - ($bsdocslen - 1)] a $docs[$i]"
								 );
				}
				# push last element, independently of 
				# having or not sliced the array
				push (@bsdocs, $docs[$i+1]);
				# reinitialize $bsdocslen
				$bsdocslen = 1;
			}
			$i++;
		}
		# if it's worthy to abbreviate, then do it:
		if ($bsdocslen >= $agglen) {
			splice (@bsdocs,
							$#bsdocs + 1 - $bsdocslen,
							$bsdocslen,
							"$docs[$i - ($bsdocslen - 1)] a $docs[$i]"
						 );
		}
	}
	# if length of @docs is less than $arrlen,
	# then simply return it as is.
	else { @bsdocs = @docs; }
	
	@bsdocs;

} # end of sub bsort

=head2 B<remove_repeated>

A função I<remove_repeated> recebe um array ordenado
de escalares e devolve um array ordenado sem elementos
repetidos.

=cut

sub remove_repeated {

	my @elems = @_;
	my @rrelems = ();
	if ((scalar @elems) >= 2) {
		if ($elems[0] == $elems[1]) {
			shift (@elems);
			@elems = &remove_repeated (@elems);
		}
		else {
			unshift (@rrelems, $elems[0]);
			shift (@elems);
			push (@rrelems, &remove_repeated (@elems));
			@elems = @rrelems;
		}
	}
	@elems;

} # end of sub remove_repeated

=head2 B<pre_process>

A função I<pre_process> recebe o nome de um ficheiro XML
e devolve o seu conteúdo subtituídas todas as entidades
de caracteres (caracter entities) por caracteres ISO-8859-1.

=cut

sub pre_process {

	open FH, $xmlfile or die ($!);
	
	local undef $/;
	$_ = <FH>;

	$_ =~ s/&aacute;/á/g;
	$_ =~ s/&eacute;/é/g;
	$_ =~ s/&iacute;/í/g;
	$_ =~ s/&oacute;/ó/g;
	$_ =~ s/&uacute;/ú/g;
	$_ =~ s/&agrave;/à/g;
	$_ =~ s/&egrave;/è/g;
	$_ =~ s/&igrave;/ì/g;
	$_ =~ s/&ograve;/ò/g;
	$_ =~ s/&ugrave;/ù/g;
	$_ =~ s/&ccedil;/ç/g;
	$_ =~ s/&atilde;/ã/g;
	$_ =~ s/&otilde;/õ/g;
	$_ =~ s/&acirc;/â/g;
	$_ =~ s/&ecirc;/ê/g;
	$_ =~ s/&icirc;/î/g;
	$_ =~ s/&ocirc;/ô/g;
	$_ =~ s/&ucirc;/û/g;

	$_ =~ s/&Aacute;/À/g;
	$_ =~ s/&Eacute;/É/g;
	$_ =~ s/&Iacute;/Í/g;
	$_ =~ s/&Oacute;/Ó/g;
	$_ =~ s/&Ugrave;/Ú/g;
	$_ =~ s/&Agrave;/À/g;
	$_ =~ s/&Egrave;/È/g;
	$_ =~ s/&Igrave;/Ì/g;
	$_ =~ s/&Ograve;/Ò/g;
	$_ =~ s/&Ugrave;/Ù/g;
	$_ =~ s/&Ccedil;/Ç/g;
	$_ =~ s/&Atilde;/Ã/g;
	$_ =~ s/&Otilde;/Õ/g;
	$_ =~ s/&Acirc;/Â/g;
	$_ =~ s/&Ecirc;/Ê/g;
	$_ =~ s/&Icirc;/Î/g;
	$_ =~ s/&Ocirc;/Ô/g;
	$_ =~ s/&Ucirc;/Û/g;

	$_ =~ s/ª/$^{a}/g;
	$_ =~ s/º/$^{o}/g;

	my $t = $_;

	close FH;

	$t;

} # end of sub pre_process

=head2 B<mk_time>

A função I<mk_time> recebe um array assoc de atributos (%v)
de arcebispos ou papas e devolve uma string de info temporal
adequada.

=cut

sub mk_time {

	local ($_ = shift);
	my %attrs = %$_;
	my $timed;
	my $sure;

	$sure = ($attrs{sure} eq 'yes' or not $attrs{sure}) ? 1 : 0;

	$timed .= $attrs{syear};
	if ($attrs{eyear} ne '')				{	$timed .= '--'.$attrs{eyear};}

	if (not $sure)									{ $timed .= "?";								}

	$timed;

} # end of sub mk_time

=head2 B<bula_space_and_time>

A função I<bula_space_and_time> recebe um array associativo
de atributos de elemento C<bula> e devolve uma string de
informação espacial/temporal apropriada.

=cut

sub bula_space_and_time {

# Exemplo de um elemento bula:
# <bula id='B1' role="BREVE" syear="1099" eyear="1108"
#				yabout="no" ysure="no" month="OUTUBRO" day="15"
#				dsure="yes" where="Roma" wsure="yes" sure="yes">

	local ($_ = shift);
	my %attrs = %$_;
	my $spacetimed;
	my $ysure = ($attrs{ysure} eq 'yes' or not $attrs{ysure}) ? 1 : 0;
	my $dsure = ($attrs{dsure} eq 'yes' or not $attrs{dsure}) ? 1 : 0;
	my $wsure = ($attrs{wsure} eq 'yes' or not $attrs{wsure}) ? 1 : 0;
	my $yabout = ($attrs{yabout} eq 'no' or not $attrs{yabout}) ? 1 : 0;

	$spacetimed .= '\textbf{';		#}

	if (not $ysure)									{ $spacetimed .= "[";								}
	if (not $yabout)								{ $spacetimed .= "c. ";							}
	$spacetimed .= $attrs{syear};
	if ($attrs{eyear} ne '')				{	$spacetimed .= '--'.$attrs{eyear};}
	if (not $ysure)									{ $spacetimed .= "]";								}

	$spacetimed .= '}';
		
	if ($attrs{month} ne '')		{ $spacetimed .= ", $attrs{month}"; 	}

#	if ($attrs{day} ne '')			{	$spacetimed .= ", ";								}
#	if (not $dsure)							{	$spacetimed .= "[";									}
#	if ($attrs{day} ne '')			{ $spacetimed .= "$attrs{day}";				}
#	if (not $dsure)							{	$spacetimed .= "]";									}
#
#	if ($attrs{where} ne '')		{ $spacetimed .= ", ";								}
#	if (not $wsure)							{	$spacetimed .= "[";									}
#	if ($attrs{where} ne '')		{ $spacetimed .= "$attrs{where}";			}
#	if (not $wsure)							{	$spacetimed .= "]";									}

	if ($attrs{day} ne '')			{
			$spacetimed .= ", ";
			$spacetimed .= (not $dsure) ? "[".$attrs{day}."]" : $attrs{day};
	}

	if ($attrs{where} ne '')		{
			$spacetimed .= ", ";
			$spacetimed .= (not $wsure) ? "[".$attrs{where}."]" : $attrs{where};
	}

	if ($attrs{sure} eq 'no')		{
			$spacetimed .= ' (?)';
	}

	$spacetimed;

} # end of sub bula_space_and_time

=head2 B<trim>

A função I<trim> recebe uma string e devolve
uma outra similar aquela, mas sem C<\n>s no
seu início e fim.

=cut

sub trim {

	$_ = shift;
	s/\n+(.*)\n+/$1/s;
	$_;

} # end of sub trim

=head2 B<trim_beggining>

A função I<trim_beginning> recebe uma string e devolve
uma outra similar aquela, mas sem C<\n>s no seu início.

=cut

sub trim_beginning {

	$_ = shift;
	s/\n+(.*)/$1/s;
	$_;

} # end of sub trim_beginning

=head2 B<bula_id>

A função I<bula_id> recebe uma string da forma B[0-9]+
e devolve a parte [0-9]+.

=cut

sub bula_id {

	$_ = shift;
	s/B([0-9]+)/$1/;
	$_;

} # end of sub bula_id

=head2 B<item_separator>

A função I<item_separator> devolve código LaTeX
referente ao separador existente entre items da
lista enumerada que aparece depois da "Introdução".

=cut

sub item_separator {

	"\n\n\\begin{center}\\verb\$*  *  *\$\\end{center}\n\n";

} # end of item_separator

=head2 B<startLaTeX>

A função I<startLaTeX> devolve código LaTeX
referente à inicialização de opções do documento,
definição de contadores e redefinição de comandos.

=cut

sub startLaTeX {

<<'START_LaTeX'
% Author: José Luís dos Santos Costa (jlsantos@aeiou.pt)
\documentclass[a4paper,12pt,openright,twoside,final]{book}
% \documentclass[a4paper,11pt,openright,twoside,final]{scrbook}
% \documentclass[a4paper,11pt,openright,twoside,final]{ltxdoc}
\usepackage[portuges]{babel}
\usepackage[latin1]{inputenc}
\usepackage{fancyhdr}
\usepackage{latexsym}

\selectlanguage{portuges}

\pagestyle{fancy}

% no indentation for paragraphs
\setlength{\parindent}{0pt}

% +2 vertical space pts between paragraphs
\setlength{\parskip}{2pt}

\setcounter{chapter}{1}
\setcounter{section}{1}
\setcounter{subsection}{1}
\setcounter{subsubsection}{1}
\setcounter{paragraph}{1}
\setcounter{subparagraph}{1}

\renewcommand{\thechapter}{\Roman{chapter}}
\renewcommand{\thesection}{\arabic{section}}
\renewcommand{\thesubsection}{\arabic{subsection}}
\renewcommand{\thesubsubsection}{\arabic{subsubsection}}
\renewcommand{\theparagraph}{\arabic{paragraph}}
\renewcommand{\thesubparagraph}{\arabic{subparagraph}}

% Definitions below are needed, because one cannot
% center, via \center{...}, a section title:
% \section{\center{Title}} isnt allowed, but one can write
% \section*{\center{Title}}

% Numbered bb chapter
\newcommand{\bbchapter}[1]{%
	\chapter*{\centering \thechapter\ -- #1}%
	\addcontentsline{toc}{chapter}{\thechapter\ --- #1}%
	\addtocounter{chapter}{1}%
	\setcounter{section}{1}%
	\bbfancyheadings{#1}%
}

% Unnumbered bb chapter
\newcommand{\ubbchapter}[1]{%
	\chapter*{\centering #1}%
	\addcontentsline{toc}{chapter}{#1}%
	\addtocounter{chapter}{1}%
	\setcounter{section}{1}%
}

% Numbered bb section
\newcommand{\bbsection}[1]{%
	\section*{\centering \thesection\ -- #1}%
	\addcontentsline{toc}{section}{\thesection\ --- #1}%
	\addtocounter{section}{1}%
	\setcounter{subsection}{1}%
}

% Unnumbered bb section
\newcommand{\ubbsection}[1]{%
	\section*{\centering #1}%
	\addcontentsline{toc}{section}{#1}%
	\addtocounter{section}{1}%
	\setcounter{subsection}{1}%
	\bbfancyheadings{#1}%
}

% Numbered bb subsection
\newcommand{\bbsubsection}[1]{%
	\subsection*{\centering \thesubsection\ -- #1}%
%	\addcontentsline{toc}{subsection}{\thesubsection\ --- #1}%
	\addtocounter{subsection}{1}%
	\setcounter{subsubsection}{1}%
}

% Unnumbered bb subsection
\newcommand{\ubbsubsection}[1]{%
	\subsection*{\centering #1}%
%	\addcontentsline{toc}{subsection}{#1}%
	\addtocounter{subsection}{1}%
	\setcounter{subsubsection}{1}%
}

% Numbered bb subsubsection
\newcommand{\bbsubsubsection}[1]{%
	\subsubsection*{\centering \thesubsubsection\ -- #1}%
%	\addcontentsline{toc}{subsubsection}{\thesubsubsection\ --- #1}%
	\addtocounter{subsubsection}{1}%
	\setcounter{paragraph}{1}%
}

% Unnumbered bb subsubsection
\newcommand{\ubbsubsubsection}[1]{%
	\subsubsection*{\centering #1}%
%	\addcontentsline{toc}{subsubsection}{#1}%
	\addtocounter{subsubsection}{1}%
	\setcounter{subsubsubsection}{1}%
}

% Numbered bb paragraph
\newcommand{\bbparagraph}[1]{%
	\paragraph*{\centering \theparagraph\ -- #1}%
%	\addcontentsline{toc}{paragraph}{\theparagraph\ --- #1}%
	\addtocounter{paragraph}{1}%
	\setcounter{subparagraph}{1}%
}

% Unnumbered bb paragraph
\newcommand{\ubbparagraph}[1]{%
	\paragraph*{\centering #1}%
%	\addcontentsline{toc}{paragraph}{#1}%
	\addtocounter{paragraph}{1}%
	\setcounter{subparagraph}{1}%
}

% Numbered bb subparagraph
\newcommand{\bbsubparagraph}[1]{%
	\subparagraph*{\centering \thesubparagraph\ -- #1}%
%	\addcontentsline{toc}{subparagraph}{\thesubparagraph\ --- #1}%
	\addtocounter{subparagraph}{1}%
}

% Unnumbered bb subparagraph
\newcommand{\ubbsubparagraph}[1]{%
	\subparagraph*{\centering #1}%
%	\addcontentsline{toc}{subparagraph}{#1}%
	\addtocounter{subparagraph}{1}%
}

% For the enumerate list in chapter "Introdução"
\renewcommand{\labelenumi}{\bf\Large\theenumi.}

% bbfancyheadings builds page headings based upon sectioning titles
\newcommand{\bbfancyheadings}[1]{%
							 \fancyhead[RE]{\textsc{Bulário Bracarense}}%
							 \fancyhead[LE]{\thepage}%
							 \fancyhead[LO]{\textsc{#1}}%
							 \fancyhead[RO]{\thepage}%
					 }

\begin{document}

\sloppy

START_LaTeX

} # end of sub startLaTeX

=head2 B<tableOfContents>

A função I<tableOfContents> devolve o código LaTeX
referente à geração da tábua das matérias.

=cut

sub tableOfContents {

<<'TOC'

\renewcommand{\contentsname}{Tábua das Matérias}

\tableofcontents

TOC

} # end of sub tableOfContents

=head2 B<anthroposIndexHeader>

A função I<anthroposIndexHeader> devolve código LaTeX
referente ao capítulo "Índices" e à secção "Índice Antroponímico".

=cut

sub anthroposIndexHeader {

<<'Anth_Idx_Hdr'

\bbchapter{ÍNDICES}

\bbsection{Índice Antroponímico}

\vspace{12pt}

Anth_Idx_Hdr

} # end of sub anthroposIndexHeader

=head2 B<toposIndexHeader>

A função I<toposIndexHeader> devolve código LaTeX
referente à secção "Índice Toponímico".

=cut

sub toposIndexHeader {

<<'Topos_Idx_Hdr'

\newpage

\bbsection{Índice Toponímico}

\vspace{12pt}

Topos_Idx_Hdr

} # end of toposIndexHeader

=head2 B<endLaTeX>

A função I<endLaTeX> devolve código LaTeX
de finalização.

=cut

sub endLaTeX {

<<'END_LaTeX'


\end{document}
END_LaTeX

} # end of sub endLaTeX

=head2 B<bbFrontPage>

A função I<bbFrontPage> devolve código LaTeX
referente à capa do Bullarium Bracarense.

=cut

sub bbFrontPage {

<<'BB_Front_Page'

\begin{titlepage}

\begin{center}

\large \textsc{Maria da Assunção Jácome de Vasconcelos}

Técnica Superior do ADB/UM

\vspace{8pt}

\large \textsc{António de Sousa Araújo}

Bolseiro da Fundação Caluoste Gulbenkian

\vspace{72pt}

\Huge

\textsc{\textbf{BULÁRIO BRACARENSE}}

\LARGE

\vspace{14pt}

\textsf{\textbf{Sumários de Diplomas Pontifícios\\
dos Séculos XI a XIX}}

\vspace{48pt}

\Large

\normalsize

$\Box$

\vspace{48pt}

\textsc{Arquivo Distrital de Braga}

\textsc{Universidade do Minho}

\vspace{48pt}

$\Box$

\vspace{48pt}

%\font\location=tri8u at 32pt
%\location

\textsc{B\,r\,a\,g\,a}

\vspace{24pt}

\textsc{1\,9\,8\,6}

\end{center}

\end{titlepage}
BB_Front_Page

} # end of sub bbFrontPage

=head2 B<load_anthspnames>

A função I<load_anthspnames> que devolve a lista de apelidos
pertences a items do índice antroponímico que I<não> seguem
a regra 1.

=cut

sub load_anthspnames {

	local (undef $/);
	$_ = <DATA>;
	# read everything between <anthspnames> and </anthspnames>
	/<anthspnames>(.*?)<\/anthspnames>/s;
	# build array of anthspnames
	my @anthspnames = split /\n/, $1;
	# return hash of $_ => 1 ($_ = each anthspname) elements
	# without empty keys (i.e., with no empty $_)
	map { ($_ ne '') ? ($_ => 1) : () } @anthspnames;

} # end of load_anthspnames

=head1 FICHEIROS

=over

=item F<bb.dtd> DTD do Bullarium Bracarense

=back

=cut

=head1 REFERÊNCIAS

=over

=item B<bb2html> Tradutor do Bullarium Bracarense de XML para HTML.

=item B<XML::DT> O melhor módulo Perl de processamento de documentos
XML, escrito pelo Mestre José João Almeida <jj@di.uminho.pt>.

=back

=cut

=head1 AUTOR

Santos, José Luís <jlsantos@aeiou.pt>

=cut

__END__
# Lista de apelidos pertencentes a items que surgem no índice
# antroponímico que NÃO DEVEM seguir a regra normal:
# APELIDO, Outras palavras,
# em que APELIDO representa a última palavra do nome em maiúsculas.
# NB: De referir que nãe é necessário incluir nesta lista nomes
# do tipo "CLEMENTE III", uma vez que todos os nomes que seguem
# esta forma (terminados em letras romanas) são já tratados de forma
# especial.
<anthspnames>
Afonso Esteves de Azambuja
Afonso Mendes
Afonso de Brito
Agostinho de Jesus
António Pereto
Bartolomeu dos Mártires
Castelo Branco
Des Prez
Diogo Gelmires
Domingos Domingues
Durão Lourenço
Egas Martins
Gaspar da Encarnação
Geraldo Domingues
Gonçalo Pereira
Gonçalo Peres
Gonçalo Velho
Guilherme Folquini
Hugo de Mirabela
J. Martim Pais
J. Peres
Jacob de Sirano
Lourenço Martins de Vilela
M. Angotes
Martinho Fernandes
Martinho Geraldes
Martinho de Oliveira
Martins de Soalhães
Mateus Visconti
Maurício Burdino
Miguel Pires
Miguel Vivas
Miguel de Cesena
Nicolau Hispano
P. Soeiro
Paio Mendes
Pedro Anes
Pedro Anes da Lagiosa
Pedro Martins
Pedro Salvador
Pedro Soares
Raimundo Ebrard I
S. Paes
Solerio Erfordense
Sá Pedro
São Geraldo
Vasco Lourenço
Vasco Martins
Vasco Rodrigues
Vila Verde
Álvaro Fernandes
</anthspnames>