#!/usr/bin/perl -w
#
# skladaczka.pl ver 0.4
#
# Na potrzeby kt.linuxnews.pl napisał Jakub Jankowski <shasta@toxcorp.com>
# Code released under GNU GPLv2 or later.
#
# [23:04:09] <pkot> algorytm składaczki:
# [23:04:52] <pkot> 1. s/xml version="1.0"/xml version="1.0" encoding="iso-8859-2"/
# [23:06:07] <pkot> 2. for each translator w komentarzu pobierz email i imię z nazwiskiem i wypuj tag translator
# [23:06:15] <pkot> 3. przetłumacz datę całości
# [23:06:43] <pkot> 4. wstaw ewentualne intro
# [23:07:00] <pkot> 5. nic poza tym nie ruszaj w "nagłówku" tylko przeklej
# [23:07:09] <pkot> 6. dokładaj wątki po kolei
#
# Changes:
#  0.1 - initial release
#  0.2 - poprawne sortowanie tablic (z uwzględnieniem ogonków),
#        minor fixes
#  0.3 - przed wklejeniem każdej sekcji dodaj komentarz z numerem
#  0.4 - przy czytaniu katalogu akceptuj TYLKO pliki o nazwie XXX-YY.xml
#          lub XXX_YY.xml, gdzie XXX to numer odcinka, a YY numer sekcji
#        data w <issue> jest już w formacie YYYY/MM/DD

use strict;
use locale;
use POSIX qw(setlocale);
setlocale(&POSIX::LC_ALL,"pl_PL");

my $VERSION = "0.4";
my @KTeam = ();
#                          nick		 adres email		 imię		 nazwisko
push(@KTeam, new_teammate('pkot',	'pkot@linuxnews.pl',	'Paweł',	'Kot'));
push(@KTeam, new_teammate('majaka',	'majaka@linuxnews.pl',	'Maja',		'Królikowska'));
push(@KTeam, new_teammate('jagger',	'rswieck1@elka.pw.edu.pl', 'Robert', 	'Święcki'));
push(@KTeam, new_teammate('zdzichu',	'zdzichu@irc.pl',	'Tomasz',	'Torcz'));
push(@KTeam, new_teammate('matti',	'matti@lexx.eu.org',	'Krzysztof',	'Wilczyński'));
push(@KTeam, new_teammate('trochej',	'damian@wojslaw.pl',	'Damian',	'Wojsław'));
push(@KTeam, new_teammate('shasta',	'shasta@toxcorp.com',	'Jakub',	'Jankowski'));

my $issue = shift;
my $dir = shift;
my $infile = shift;
my $outfile = shift;

my @issue_translators = ();
my @issue_correctors = ();
my @issue_filenames = ();
my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

local *IN;
local *OUT;

my $has_intro = 0;
my $in_intro = 0;

if (!defined($issue) || !defined($dir) || !defined($infile) || !defined($outfile) || $issue !~ /^([0-9]{3})$/) {
	print_usage();
	exit(1);
}

$dir =~ s/([\/]+)$//;


# struct teammate new_teammate($nick, $email, $fullname)
sub new_teammate {
	my $t = {};
	$t->{nick} = $_[0];
	$t->{email} = $_[1];
	$t->{firstname} = $_[2];
	$t->{lastname} = $_[3];
	return $t;
}

# void print_usage()
# prints usage howto
sub print_usage {
	print("Użycie: ./skladaczka.pl <odcinek> <katalog_z_sekcjami> <oryginalny_xml> <plik_wynikowy>\n");
}

# void print_info()
sub print_info {
	print("Składaczka ver. $VERSION\n");
	print("\t  Składam odcinek: $issue\n");
	print("\tPliki cząstkowe w: $dir\n");
	print("\t   Plik wyjściowy: $outfile\n");
	print("\t   Plik wejściowy: $infile\n");
}

# str my_lc($string)
# robi lowercase z uwzględnieniem polskich znaków diaktrycznych
# assumes iso-8859-2
sub my_lc ($) {
	my ($str) = @_;
	$str =~ tr/\241\306\312\243\321\323\246\257\254/\261\346\352\263\361\363\266\277\274/;
	return $str;
}

# int getmonth($string)
sub getmonth {
	my $num = 0;
	foreach my $mon (@months) {
		$num++;
		last if ($mon =~ /\Q$_[0]\E/i);
	}
	return sprintf('%.2d', $num);
}

# bool in_array($who, 'translators|correctors');
sub in_array {
	my ($who, $where) = @_;
	if ($where =~ /transl/i) {
		foreach my $t (@issue_translators) {
			return 1 if ($t->{nick} =~ /\Q$who\E/i);
		}
	} elsif ($where =~ /correct/i) {
		foreach my $c (@issue_correctors) {
			return 1 if ($c->{nick} =~ /\Q$who\E/i);
		}
	}
	return 0;
}

# struct teammate get_teammate($nick)
sub get_teammate {
	foreach my $m (@KTeam) {
		return $m if ($m->{nick} =~ /\Q$_[0]\E/i);
	}
}

# void get_involved_people()
# fills @issue_translators/correctors
# uses @issue_filnames
sub get_involved_people {
	my @tmpt = ();
	my @tmpc = ();
	foreach my $file (@issue_filenames) {
#		print("Sprawdzam plik $dir/$file\n");
		my $got_translator = 0;
		my $got_corrector = 0;
		local *F;
		open(F, "<$dir/$file") or die "open";
		while(<F>) {
			chomp;
			if (/\<\!--[\ ]*translator\:.([a-zA-Z0-9]+)[\ ]*--\>/i && !$got_translator) {
				push(@tmpt, $1);
				$got_translator = 1;
			}
			if (/\<\!--[\ ]*corrector\:.([a-zA-Z0-9]+)[\ ]*--\>/i && !$got_corrector) {
				push(@tmpc, $1);
				$got_corrector = 1;
			}
			last if ($got_translator && $got_corrector);
		}
		close(F);
	}
	foreach my $t (@tmpt) {
		push(@issue_translators, get_teammate($t)) unless in_array($t, 'translators');
	}
	foreach my $c (@tmpc) {
		push(@issue_correctors, get_teammate($c)) unless in_array($c, 'correctors');
	}
	@issue_translators = sort {my_lc($a->{lastname}) cmp my_lc($b->{lastname})} @issue_translators;
	@issue_correctors = sort {my_lc($a->{lastname}) cmp my_lc($b->{lastname})} @issue_correctors;
}

# int get_issue_files()
# fills @issue_filenames with filenames found in $dir
# returns number of processed files or -1 on failure
sub get_issue_files {
	local *D;
	return -1 unless (defined $dir && defined $issue);
	return -1 unless opendir(D, "$dir");
	@issue_filenames = grep { /^\Q$issue\E[-_][0-9]{1,2}\.xml$/ && -r "$dir/$_"} readdir(D);
	closedir(D);
	@issue_filenames = sort sectsort @issue_filenames;
	return scalar(@issue_filenames);
}

sub sectsort ($$) {
	my ($a) = $_[0] =~ /^[0-9]{3}-([a-zA-Z0-9]+)\.xml$/;
	my ($b) = $_[1] =~ /^[0-9]{3}-([a-zA-Z0-9]+)\.xml$/;
	$a =~ s/^([0-9])$/0$1/;
	$b =~ s/^([0-9])$/0$1/;
	$has_intro = 1 if ($a == 0);
	$a cmp $b;
}

sub main {
	# welcome note
	print_info();

	# pobieramy z $dir wszystkie pliki typu $issue-([0-9a-zA-Z]+).xml
	# tablica się potem sortuje.
	if ((my $filenum = get_issue_files()) < 0) {
		print("get_issue_files dało dupy\n");
		exit(1);
	} elsif ($filenum == 0) {
		print("Nie ma nic do złożenia...\n");
		exit(0);
	}

	# z plików pobranych przed chwilą wyciągamy wszystkich tłumaczy
	# i korektorów do odpowiednich tablic, które się potem `uniq`ują
	# i sortują
	get_involved_people();

	# trochę debuggingu
	print("\nTłumaczenie odcinka $issue:\n");
	foreach my $t (@issue_translators) {
		print(" $t->{firstname} '$t->{nick}' $t->{lastname} <$t->{email}>\n");
	}
	print("\nKorekta odcinka $issue:\n");
	foreach my $c (@issue_correctors) {
		print(" $c->{firstname} '$c->{nick}' $c->{lastname} <$c->{email}>\n");
	}

	print("\nOdcinek $issue posiada również przetłumaczone intro.\n") if ($has_intro);

	print("\nRozpoczynam składanie pliku...\n\n");

	print("Otwieram pliki $infile i $outfile\n");
	open(IN, "<$infile") or die "Nie można otworzyć $infile: $!";
	open(OUT, ">$outfile") or die "Nie można otworzyć pliku $outfile: $!";
	while(<IN>) {
		# zmiana nagłówka
		if (/\<\?xml\ version=\"([0-9.]+)\"[\ ]*\?\>\n$/) {
			print("Tłumaczę <?xml...\n");
			print(OUT "<?xml version=\"$1\" encoding=\"iso-8859-2\" ?>\n");
			next;
		}
		# po tagu author wstawimy translatorów
		if (/\<\/author\>\n$/) {
			print(OUT $_);
			print(OUT "\n");
			foreach my $t (@issue_translators) {
				print("Wstawiam tag <translator lang=\"Polish\" email=\"$t->{email}\">$t->{firstname} $t->{lastname}</translator>\n");
				print(OUT "<translator lang=\"Polish\" email=\"$t->{email}\">$t->{firstname} $t->{lastname}</translator>\n");
			}
			next;
		}
		# tłumaczymy datę (SIC!)
		if (/^\<issue\ +num=\"([0-9]+)\"\ +date=\"([0-9]{1,2})\ ([A-Za-z]{3})\ ([0-9]{4})\ ([0-9a-zA-Z\:\-\+\ ]+)\"\ *\/\>\n$/) {
			print("Tłumaczę datę: <issue num=\"$1\" date=\"$4/" . getmonth($3) . "/$2\" />\n");
			print(OUT "<issue num=\"$1\" date=\"$4/" . getmonth($3) . "/$2\" />\n");
			next;
		}

		# <intro>
		if (/^\<intro\>\n$/ && $has_intro) {
			print("Przepisuję INTRO.");
			$in_intro = 1;
			local *I;
			open(I, "<$dir/$issue_filenames[0]") or die "Nie mogę otworzyć $dir/$issue_filenames[0]: $!";
			# przepisujemy przetłumaczone intro
			while(<I>) {
				print(".");
				print(OUT $_);
			}
			close(I);
			# zdejmujemy plik z intrem z listy
			shift(@issue_filenames);
			next;
		}

		# </intro>
		if (/^\<\/intro\>\n$/ && $has_intro) {
			print(". Koniec INTRO.\n");
			$in_intro = 0;
			next;
		}

		# pierwszy tag <section> -- od tej chwili wklejamy tłumaczenia!
		if (/^\<section\n$/) {
			print("Koniec statystyk, zamykam plik wejściowy $infile.\n");
			last;
		}
		# przeklejamy resztę, chyba że jesteśmy akurat w intro
		print(OUT $_) unless $in_intro;
	}
	# oryginał już nam nie będzie potrzebny
	close(IN);

	# a teraz przepisujemy przetłumaczone wątki,
	# dodając przed każdym wątkiem komentarz <!-- section: YY -->
	print("Wklejanie przetłumaczonych sekcji: ");
	my $counter = 0;
	foreach my $file (@issue_filenames) {
		if ($file =~ /^[0-9]{3}-([a-zA-Z0-9]+)\.xml$/) {
			print("$1,");
		} else {
			next;
		}
		print(OUT "<!-- section: $1 -->\n");
		local *SECTION;
		open(SECTION, "<$dir/$file") or die "Nie mogę otworzyć $dir/$file: $!";
		while(<SECTION>) {
			print(OUT $_);
		}
		print(OUT "\n");
		close(SECTION);
		$counter++;
	}
	print(".\nDodanych sekcji: $counter.\n");

	# na końcu dodamy jeszcze zamykający tag kc
	print("Dodaję tag </kc>\n");
	print(OUT "\n</kc>\n");
	close(OUT);

	# That's all folks!
	print("\nWygląda na to, że wszystko skończyło się pomyślnie.\nHappy reading!\n");
}

main();
exit(0);