﻿#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use open qw(:std :utf8);
use integer;


# Abruzzen-places2.pl
# 2010-10-07
# Wolfgang Schmidle

# geprüft: Es gibt kein <p> mit mehr als einem <pb>
# geprüft: <p> hat nie irgendwelche Attribute
# geprüft: es gibt kein <pb> innerhalb von <top>

# text input

my @text;
while(<>) { push @text, $_; }


# go through the text

my $pb = 0;
my $pbN = "";
my $nr = 0;
my $nrN = "";

my @places = ();
my @tabelle = ();


my @newText;

foreach (@text) {

	if (m!^(.*)(<pb n="\d+"/>)(.*)$!) {	
		push @newText, $1;
		push @newText, $2;
		push @newText, $3 . "\n";
		next;
	}
	push @newText, $_;
}

foreach (@newText) {

	last if m!<index>!;
	
	
	if (m!<pb n="(\d+)"/>!) {

#		if ($1 != $pb+1) { warn "$pb\n"; }

		$pb = $1;
		$pbN = $pb;
		if ($pb < 10) { $pbN = "0$pbN"; }
		if ($pb < 100) { $pbN = "0$pbN"; }
		$nr = 0;
		next;
	}
	
	while (m!<top ref="([^"]+)">([^<]+)</top>!) {
	
		$nr++;
		$nrN = $nr;
		if ($nr < 10) { $nrN = "0$nrN"; }
		
		my $id = "$pbN-$nrN";
		my $nummer = $1;
		my $name = $2;

		s!<top ref="[^"]+">[^<]+</top>!<place id=\"$id\">$name</place>!;

#		push @places, "<place id=\"$id\">$name</place>\n";
#		push @tabelle, "$id\t$pb\t$name\t$nummer\n";
	}
	
}

#warn @places;
#warn @tabelle;
#die "That's all.\n";

print @newText;

# TO DO:
