#!/usr/bin/perl
#
# Script to make installation of files in date space easy when publishing

use strict;
use XML::DOM;
use File::Copy;
use URI;

if ($#ARGV != 4) {
    die "Usage: $0 <pubdir> <doc> <year> <month> <day>";
}

my $WWW = $ENV{WWW};
my ($PUBDIR, $DOC, $Y, $M, $D) = @ARGV;
my $TARGET = "$WWW/$Y/$M/wsdl";

if (! -d $WWW) {
    die "\$WWW ($WWW) doesn't exist";
}

sub getTitle() {
    my $f = "$PUBDIR/Overview.html";
    my $parser = new XML::DOM::Parser;
    my $doc = $parser->parsefile($f);
    my $t = $doc->getElementsByTagName('title')->item(0)->getFirstChild()->getNodeValue() || die "$f: $!";
    $t =~ s/\n/ /;
    $t =~ s/ +/ /;
    return $t;
}

my $TITLE = &getTitle();

my $ID;
if ($DOC =~ m/wsdl20-$Y$M$D/) {
    $ID = 'PART1';
}
elsif ($DOC =~ m/wsdl20-primer-$Y$M$D/) {
    $ID = 'PART0';
}
elsif ($DOC =~ m/wsdl20-adjuncts-$Y$M$D/) {
    $ID = 'PART2';
}
elsif ($DOC =~ m/wsdl20-soap11-binding-$Y$M$D/) {
    $ID = 'SOAP11';
} else {
    die "Unknown document type";
}

###########################################################################

sub createDir() {
    my $d = $_[0];
    if (! -d $d) {
	mkdir($d) || die "$!";
	print "Created $d\n";
    }
}

&createDir("$WWW/$Y");
&createDir("$WWW/$Y/$M");
&createDir("$TARGET");

if ($ID eq 'PART2') {
    &createDir("$TARGET/style");
    &createDir("$TARGET/style");
}

###########################################################################

sub readFromDoc() {
    my ($fn) = @_;
    my $f;
    open($f, $fn) || die "$fn: $!";
    my $c = join('', <$f>);
    close($f);
    return $c;
}

sub readFromTemplate() {
    my ($fn, $common) = @_;
    my $c = &readFromDoc("templates/$fn");
    if ($common != 1) {
	$c =~ s|\@TRLOC\@|$Y/$DOC|g;
	$c =~ s|\@TITLE\@|$TITLE|g;
    }
    $c =~ s|\@Y\@|$Y|g;
    $c =~ s|\@M\@|$M|g;
    $c =~ s|\@D\@|$D|g;
    my $signatureTemplate = &readFromDoc("templates/signature");
    $c =~ s|\@SIG\@|$signatureTemplate|g;
    return $c;
}

sub writeInDoc() {
    my ($fn, $c) = @_;
    my $f;
    open($f, "> $fn") || die "$fn: $!";
    print $f $c;
    close($f);
}

###########################################################################

sub updateHtaccess() {
    my $htaccess = "$TARGET/.htaccess";
    my $c;
    if (-f $htaccess) {
	$c = &readFromDoc($htaccess);
    } else {
	$c = &readFromTemplate("htaccess");
    }
    my $v = "# $ID-BEGIN\n";
    if ($ID eq 'PART1') {
	$v .= '
DirectoryIndex wsdl20
';
    }
    elsif ($ID eq 'PART2') {
	$v .= '
RewriteRule   ^in-out$                  patterns.html
RewriteRule   ^in-opt-out$              patterns.html
RewriteRule   ^out-only$                patterns.html
RewriteRule   ^robust-out-only$         patterns.html
RewriteRule   ^robust-in-only$          patterns.html
RewriteRule   ^out-in$                  patterns.html
RewriteRule   ^out-opt-in$              patterns.html
RewriteRule   ^in-only$                 patterns.html
RewriteRule   ^in-multi-out$            patterns.html
RewriteRule   ^out-multi-in$            patterns.html
RewriteRule   ^asynch-out-in$           patterns.html

RewriteRule   ^fault-replaces-message$  faults.html
RewriteRule   ^message-triggers-fault$  faults.html
RewriteRule   ^no-faults$               faults.html
';
    }
    $v .= "\n# $ID-END\n";
    $c =~ s/\# $ID-BEGIN\n.*\# $ID-END\n/$v/s;
    &writeInDoc($htaccess, $c);
    print "Updated .htaccess\n";
}

&updateHtaccess();

###########################################################################

sub genRDDLDoc() {
    &genRDDLFromTemplate(@_, "xhtml");
    &genRDDLFromTemplate(@_, "html");
}

sub genRDDLFromTemplate() {
    my ($t, $d, $ns, $latest, $common, $ext) = @_;
    my $c = &readFromTemplate("rddl.$ext", $common);
    if ($common) {
	# Common to Part 1 and 2
	# Watch out for this: it will break if the documents change name!
	my $D2 = $DOC;
	$D2 =~ s/wsdl20/wsdl20-adjuncts/;
	my $T2 = $TITLE;
	$T2 =~ s/1: Core Language/2: Adjuncts/;
	$c =~ s|href="http://www.w3.org/TR/\@TRLOC\@/"\>\@TITLE\@\</a\>|href="http://www.w3.org/TR/$Y/$DOC/">$TITLE</a> and <a href="http://www.w3.org/TR/$Y/$D2/">$T2</a>|;
	$c =~ s|\@TITLE\@|$TITLE and $T2|;
	$c =~ s|specification\.|specifications.|g;
	$c =~ s|\@TRLOC\@|$Y/$DOC|g;
	if ($ext eq 'xhtml') {
	    $c =~ s|/a> and <a href|/a></rddl:resource> and <rddl:resource id="WSDL20_Adjuncts_Spec" xlink:title="WSDL 2.0 Adjuncts specification" xlink:role="http://www.isi.edu/in-notes/iana/assignments/media-types/text/html" xlink:arcrole="http://www.rddl.org/purposes#normative-reference" xlink:href="http://www.w3.org/TR/$Y/$D2/" xlink:type="simple" xlink:show="none" xlink:actuate="none"><a href|;
	}
    }
    $c =~ s|\@NS\@|$ns|g;
    $c =~ s|\@LATEST\@|http://www.w3.org/2002/ws/desc/ns/$latest.xsd|g;
    my $target = $t;
    $target =~ s|$WWW|http://www.w3.org|;
    my $normal = URI->new_abs("$d.xsd", "$target/")->canonical;
    $c =~ s|\@THIS\@|$normal|g;
    my @a = split('/', $d);
    my $n = $a[$#a];
    $c =~ s|\@ALT\@|$n|g;
    &writeInDoc("$t/$d.$ext", $c);
    print "Generated $d.$ext\n";
}

sub moveSchema() {
    my ($s, $d, $ns, $latest, $common) = @_;
    my $src = "$PUBDIR/$s";
    my $dst = "$TARGET/$d.xsd";
    move($src, $dst) || die "mv $src $dst: $!";
    print "Installed $d.xsd\n";
    if ($common == 1) {
	&genRDDLDoc($TARGET, $d, $ns, $latest, 1);
    } else {
	&genRDDLDoc($TARGET, $d, $ns, $latest, 0);
    }
}

if ($ID eq 'PART1') {
    &moveSchema("wsdl20.xsd", "wsdl20", "WSDL 2.0", "wsdl20");
    &moveSchema("wsdl20-instance.xsd", "../wsdl-instance", "WSDL Instance", "wsdl-instance");
    &moveSchema("wsdl20-extensions.xsd", "../wsdl-extensions", "WSDL Extensions", "wsdl-extensions", 1);
}
elsif ($ID eq 'PART2') {
    &moveSchema("wsdl20-soap.xsd", "soap", "WSDL 2.0 SOAP Binding", "soap");
    &moveSchema("wsdl20-http.xsd", "http", "WSDL 2.0 HTTP Binding", "http");
    &moveSchema("wsdl20-rpc.xsd", "rpc", "WSDL 2.0 RPC Style", "rpc");
    print "Removing wsdl20-extensions.xsd...\n";
    unlink("$PUBDIR/wsdl20-extensions.xsd");
}

###########################################################################
# Patterns & Fault Propagation Rules

if ($ID eq 'PART2') {
    my $c = &readFromTemplate("patterns.html");
    &writeInDoc("$TARGET/patterns.html", $c);
    print "Generated patterns.html\n";
    my $c = &readFromTemplate("faults.html");
    &writeInDoc("$TARGET/faults.html", $c);
    print "Generated faults.html\n";
}

###########################################################################
# Styles

sub genStyleDoc() {
    my ($fn, $name) = @_;
    my $c = &readFromTemplate("style.html");
    $c =~ s|\@NAME\@|$name|g;
    &writeInDoc("$TARGET/style/$fn", $c);
    print "Generated style/$fn\n";
}

if ($ID eq 'PART2') {
    &genStyleDoc('rpc.html', 'RPC');
    &genStyleDoc('iri.html', 'IRI');
    &genStyleDoc('multipart.html', 'Multipart');
}

###########################################################################
# SOAP 1.1 HTTP binding

if ($ID eq 'SOAP11') {
    my $c = &readFromTemplate("soap11-binding.html");
    &createDir("$TARGET/../soap11");
    &createDir("$TARGET/../soap11/bindings");
    &writeInDoc("$TARGET/../soap11/bindings/HTTP.html", $c);
    print "Generated soap11/bindings/HTTP\n";
}