#!/usr/local/bin/perl -w 
# -*- perl -*-
######################################################################
# maketlk-real.pl -- Make tlk file from the wiki repository
# Copyright (c) 2007 Tero Kivinen
# All Rights Reserved.
######################################################################
#         Program: maketlk-real.pl
#	  $Source: /home/cereacvs/cvsroot/cerea2/perllib/maketlk-real.pl,v $
#	  Author : $Author: kivinen $
#
#	  (C) Tero Kivinen 2007 <kivinen@iki.fi>
#
#	  Creation          : 20:43 Jan 4 2007 kivinen
#	  Last Modification : 23:45 tammi  4 2007 smbkivinen
#	  Last check in     : $Date: 2007/01/04 21:49:04 $
#	  Revision number   : $Revision: 1.1 $
#	  State             : $State: Exp $
#	  Version	    : 1.129
#	  Edit time	    : 93 min
#
#	  Description       : Make tlk file from the wiki repository
#
#	  $Log: maketlk-real.pl,v $
#	  Revision 1.1  2007/01/04 21:49:04  kivinen
#	  	Created.
#	
#	  $EndLog$
#
#
#
######################################################################
# initialization

require 5.6.0;
package MakeTlk;
use strict;
use Tlk;
use TlkWrite;
use CereaUtils;
use LWP;
use LWP::UserAgent;

######################################################################
# Main function

sub maketlk {
    my($top) = @_;
    my($result, $tlk, @items, $i, $id, $text);

    CereaUtils::get_version();
    CereaUtils::read_config($top . "/config.pl", ".maketlkrc");

    CereaUtils::parse_options("output|o=s" => \$Opt::output_tlk,
                              "url|u=s" => \$Opt::url,
                              "base|b=s" => \$Opt::base_url);

    if (!defined($Opt::base_url)) {
        $Opt::base_url =
            "http://www.cerea2.com/components/com_openwiki/data/pages/";
    }
    if (!defined($Opt::url)) {
        $Opt::url = "build/tlk.txt";
    }
    if (!defined($Opt::output_tlk)) {
        $Opt::output_tlk = "cerea2.tlk";
    }

    $result = fetch_url($Opt::url);

    @items = split(/\n/, $result);
    @items = grep { /^\|/ } @items;

    printf("Found %d items\n", $#items) if ($Opt::verbose > 1);
    print(join("\n", @items)) if ($Opt::verbose > 6);
    
    $tlk = Tlk->new();
    $tlk->string_count(0);
    foreach $i (@items) {
        if ($i =~ /^\|\s*(\d+|0x[0-9a-fA-F]+)\s*\|[^\|]*\|[^\|]*\|\s*(.*)\s*\|\s*$/) {
            $id = $1;
            $text = $2;
            while ($text =~ /(.*)\[\[([^\]]*)\]\](.*)/) {
                $text = $1 . fetch_url($2, 1) . $3;
            }
            print("[$id]Text:\t$text\n") if ($Opt::verbose > 5);
            $text = wiki_to_nwn($text);
            print("[$id]Text:\t$text\n") if ($Opt::verbose > 3);
	    $id = oct $id if ($id =~ /^0/);
            $tlk->string($id, $text);
        } else {
            warn "Invalid entry $i";
        }
    }
    print("Writing file $Opt::output_tlk out\n") if ($Opt::verbose);
    &TlkWrite::write($tlk, filename => $Opt::output_tlk);
}

######################################################################
# Fetch file from wiki

sub fetch_url {
    my($base, $remove_links) = @_;
    my($ua, $req, $res, $result);

    $base =~ tr/ \':A-Z/__\/a-z/;
    if ($base !~ /\.txt$/) {
        $base .= ".txt";
    }
    $ua = new LWP::UserAgent;
    $ua->agent("MakeTlk/$Prog::version " . $ua->agent);
    $req = HTTP::Request->new(GET => $Opt::base_url . $base);
    $res = $ua->request($req);
    if (!$res->is_success) {
        die "Cannot get url $Opt::base_url$base";
    }
    $result = $res->content;
    if (defined($remove_links) && $remove_links) {
        $result =~ s/\[\[[^\]]*:/\[\[/g;
        $result =~ s/\[\[[^\]]*\|/\[\[/g;
        $result =~ s/\[\[([^\]]*)\]\]/$1/g;
    }
    return $result;
}

######################################################################
# Convert file from wiki format to nwn2 tlk format

sub wiki_to_nwn {
    my($text) = @_;
    $text =~ s/\%([0-9a-fA-f][0-9a-fA-f])/pack("H*", $1)/ge;
    $text =~ s/\t/    /gs;
    $text =~ s/[ ]*$//gm;
    $text =~ s/(=)\n([^\n])/$1\n\n$2/gs;
    $text =~ s/\n([^\n]*):[ ]*(\\\\\n|\n\n)/\n<color=Red><b>$1:<\/b><\/color>$2/gs;
    $text =~ s/\^/\|/g;
    $text =~ s/^[ ]*\|[ ]*//gm;
    $text =~ s/[ ]*\|[ ]*$/\\\\/gm;
    $text =~ s/^([^\|\n]*?)[ ]*\|[ ]*/<color=Magenta><b>$1:<\/b><\/color> /gm;
    $text =~ s/[ ]*\|[ ]*/: /gm;
    $text =~ s/([^\n])\n([^\n])/$1 $2/gs;
    $text =~ s/[ ]*\\\\[ ]*/\n/gs;
    $text =~ s/\*\*([^\*]*)\*\*/<b>$1<\/b>/g;
    $text =~ s/\/\/([^\/]*)\/\//<i>$1<\/i>/g;
    $text =~ s/==+[ ]*([^=]*)[ ]*==+/<color=Gold><b>$1<\/b><\/color>/gm;
    $text =~ s/\n\n\n*/\n\n/g;
    return $text;
}

1;