#!/usr/bin/perl -w

use strict;
require XML::Simple;
#use Data::Dumper;
use vars qw($xs $xml $PREABLE %op);

%op = ('NEWS.docb'         => \&to_NEWS_docb,
       'CREDITS.docb'      => \&to_CREDITS_docb,
       'CREDITS.html_body' => \&to_CREDITS_html_body);

$PREABLE = q{
<para>
This project has been alive for several years. Many people have provided
feedback that have improved poldek, especially
<ulink url="http://pld-linux.org">PLD Linux</ulink> Team people. Thanks!</para>
<para> Here follows a list of people that have
contributed (in alphabetical order). <emphasis>Please</emphasis> let
<ulink url="mailto: mis @ pld-linux.org">me</ulink>
know if somebody is missing.
</para>
};

die "Usage: $0 {" . join('|', sort keys %op) . "}\n"
  if @ARGV == 0 || !exists $op{$ARGV[0]};

$xs = new XML::Simple();
$xml = $xs->XMLin('NEWS.xml', keeproot => 1,
                  keyattr => [], forcecontent => 1) || die "XML::Simple error";

&{$op{$ARGV[0]}}($xml);

sub to_NEWS_docb {
    system("xsltproc NEWSdocb.xsl NEWS.xml") == 0 ||
      die "xsltproc failed: $?";
}

sub to_CREDITS_html_body {
    my $ref = shift;
    my $credits = get_credits($ref);
    my $preable = $PREABLE;
    $preable =~ s/(\W)para>/${1}p>/g;
    $preable =~ s/(\W)emphasis>/${1}em>/g;
    $preable =~ s/(\W)ulink([\s>])/$1a$2/g;
    $preable =~ s/url=/href=/g;
    print qq{<h1>Credits</h1>$preable};
    print q{<ul class="plain">};

    foreach (@$credits) {
        #print STDERR "$_->{name}\n";
        my $email = "";
        
        if ($_->{email}) {
    	    $email = " &lt;<em>$_->{email}</em>&gt;";
        }
        
        print qq{<li>$_->{name}$email</li>\n};
    }
    print q{</ul>};
}

sub to_CREDITS_docb {
    my $ref = shift;
    my $credits = get_credits($ref);
    
    binmode(STDOUT, ":utf8");

    print q{<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN" "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">
<article lang="en"><articleinfo><title>Credits</title></articleinfo>
<sect1 id="credits"><title></title>};

    print $PREABLE;

    print q{
<itemizedlist id="creditslist">
           };

    foreach (@$credits) {
        $_->{email} =~ s/\s/&#160;/g;
        $_->{name} =~ s/\s/&#160;/g;
        print qq{
  <listitem id="$_->{id}"><para>
     $_->{name}&#160;<emphasis>&lt;$_->{email}&gt;</emphasis>
   </para></listitem>
                };
    }
    print q{
</itemizedlist>
</sect1>
</article>
           };
}

sub get_credits {
    my $ref = shift;

    my %credits = ();

    foreach my $rel (@{$ref->{news}->{release}}) {
        $rel->{entry} = [ $rel->{entry} ] if ref $rel->{entry} eq 'HASH';
        process_entry($rel->{entry}, \%credits);

        if ($rel->{section}) {
            $rel->{section} = [ $rel->{section} ] if ref $rel->{section} eq 'HASH';
            foreach my $s (@{$rel->{section}}) {
                die if !$s->{entry};
                $s->{entry} = [ $s->{entry} ] if ref $s->{entry} eq 'HASH';
                process_entry($s->{entry}, \%credits);
            }
        }
    }
    my @credits = ();
    foreach my $au (sort { $credits{$a}->{orderby} cmp $credits{$b}->{orderby} } keys %credits) {
        push @credits, $credits{$au};
    }
    return \@credits;
}

sub process_entry {
    my $aref = shift;
    my $credits = shift;

    foreach my $e (@{$aref}) {
        next if !$e->{author};
        $e->{author} = [ $e->{author} ] if ref $e->{author} eq 'HASH';

        foreach my $au (@{$e->{author}}) {
            next if $au->{part};
            if (exists $credits->{$au->{id}}) {
        	if ( !($credits->{$au->{id}}->{email}) ) {
        	    $credits->{$au->{id}}->{email} = $au->{email};
        	}        	
        	next;
            }
            my $name = $au->{content};
            $name =~ s/^\s+//;
            $name =~ s/\s+$//;
            $name =~ s/\s+/ /;

            my $orderby = $name;
            if ($name =~ /\s/) {
                my ($n, $ln) = ($name =~ /(\S+)\s(\S+)/);
                $orderby = $ln if $ln;
            }

            $credits->{$au->{id}} = {
                                     id => $au->{id},
                                     name => $name,
                                     orderby => $orderby,
                                     email => $au->{email},
                                    };
        }
    }
}
