#!/usr/bin/perl -w
#  *****************************************************************************
#
#	publish
#	Publish site (generate static HTML)
#
#	Based loosely on GenHTMLPlugin
#	Copyright (C) 2001 Motorola
#
#   Revisions copyright (C) 2002, Eric Scouten
#
# ******************************************************************************
#
# TWiki WikiClone (see TWiki.pm for $wikiversion and other info)
#
# Copyright (C) 2001 Peter Thoeny, Peter@Thoeny.com
# Copyright (C) 2001 Sven Dowideit, svenud@ozemail.com.au
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html
#

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use File::Copy;
use File::Path;
use lib ('.');
use lib ('../lib');
use TWiki;

use strict;

use vars qw($query $thePathInfo $theRemoteUser $theUrl $debug $webPubDir $webPubUrlPath $publishDir $publishUrlPath $noWebDir $blah);

$blah = "."; # x 16384;

&main();


# ******************************************************************************
#
#	Main rendering loop.
#

sub main {

	# Read command-line arguments and make 

	# Fill in default environment variables if invoked from command-line.

	$ENV{HTTP_USER_AGENT} = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)" if (!exists $ENV{HTTP_USER_AGENT});
	$ENV{REMOTE_ADDR} = "127.0.0.1" if (!exists $ENV{REMOTE_ADDR});
	$ENV{REMOTE_PORT} = "2509" if (!exists $ENV{REMOTE_PORT});
	$ENV{REMOTE_USER} = "TWikiGuest" if (!exists $ENV{REMOTE_USER});
	$ENV{REQUEST_METHOD} = "GET" if (!exists $ENV{REQUEST_METHOD});
	$ENV{QUERY_STRING} = "" if (!exists $ENV{QUERY_STRING});

	# Tweak environment variables depending on command-line arguments.

	foreach my $arg (@ARGV) {
		
		if ($arg =~ /^\-/) {

			if ($arg eq "-y") {
				if ($ENV{QUERY_STRING}) {
					$ENV{QUERY_STRING} .= "&goAhead=yes";
				} else {
					$ENV{QUERY_STRING} = "goAhead=yes";
				}
			} else {
				die "Unknown command-line option $arg\n";
			}

		} else {

			$ENV{PATH_INFO} = "/$arg" if (!exists $ENV{PATH_INFO});

		}

		$debug = 1;

	}

	die "Don't know what web to publish\n" if (!exists $ENV{PATH_INFO});

	# Now do normal CGI init.

	$query = new CGI;
	my $thePathInfo = $query->path_info(); 
	my $theRemoteUser = $query->remote_user();
	my $theTopic = $query->param('topic');
	my $theUrl = $query->url;

	my $inclusions = $query->param('inclusions');
	my $exclusions = $query->param('exclusions');
	my $goAhead = $query->param('goAhead');
	$debug = $query->param('debug');

	print "Content-type: text/plain\n\n" if ($debug);
	$| = 0 if ($debug);

	my ($topic, $web, $scriptUrlPath, $userName, $dataDir)
		= &TWiki::initialize($thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query);

	my $wikiUserName = &TWiki::userToWikiName($userName);

	# Print environment variables for debugging.

	if ($debug) {

		print "Content-type: text/plain\n\n";
		foreach my $key (sort keys %ENV) {
			print "$key => $ENV{$key}\n";
		}

	}

	# Make sure TWiki.cfg has proper variables.

	$publishDir = &TWiki::getPublishDir();
	$publishUrlPath = &TWiki::getPublishUrlPath();

	if (!$publishDir || !$publishUrlPath) {
		&TWiki::redirect($query, &TWiki::getOopsUrl($web, $topic, "oopspublisherr"));
		return;
	}

	$webPubDir = &TWiki::Func::getPubDir() . "/" . $web;
	$webPubUrlPath = &TWiki::Func::getPubUrlPath() . "/" . $web;

	# Has user selected topic(s) yet?

	if (!$goAhead) {

		&chooseTopicScreen($web, $topic);

	} else {

		# By default, the web is published to $publishDir/$web. If the NOWEBDIR flag exists,
		# we'll publish to $publishDir instead.
		
		$noWebDir = $query->param("noWebDir") || &TWiki::Prefs::getPreferencesValue("NOWEBDIR");

		# Ugly hack because oops URL fails later in the game.

		my $successURL = &TWiki::getOopsUrl($web, $topic, "oopspublished", $noWebDir ? "$publishUrlPath" : "$publishUrlPath$web");
		my $succeeded = &publishWeb($web, $topic, $inclusions, $exclusions);

		# Send e-mail notification.

		my @notifylist = &TWiki::getEmailNotifyList($web);
		if (@notifylist && ($#notifylist >= 0)) {

			my $text = "From: " . &TWiki::Prefs::getPreferencesValue("WIKIWEBMASTER") . "\n";
			$text .= "To: " . (join ', ', @notifylist) . "\n";
			$text .= "Subject: \%WIKITOOLNAME\%.\%WEB\% - Automated notification of publication\n\n";
			
			$text .= "This is an automated email notification of \%WIKITOOLNAME\%.\n\n";

			$text .= "The web \%WEB\% has been published. To see the published content, see\n\n";
			
			$text .= $noWebDir ? "  $TWiki::urlHost$publishUrlPath\n\n" : "  $TWiki::urlHost$publishUrlPath$web\n\n";
			
			$text .= "Review recent changes in:\n";
			$text .= "  $TWiki::urlHost$scriptUrlPath/view%SCRIPTSUFFIX%/%WEB%/WebChanges\n\n";

			$text .= "Subscribe / Unsubscribe in:\n";
			$text .= "  $TWiki::urlHost$scriptUrlPath/view%SCRIPTSUFFIX%/%WEB%/%NOTIFYTOPIC%\n\n";

			$text = &TWiki::handleCommonTags( $text, $topic );

			my $error = &TWiki::Net::sendEmail( $text );

		}

		# Succeeded.

		&TWiki::redirect($query, $successURL) if ($succeeded);
		
	}

}


# ******************************************************************************
#
#	 Display screen so user can decide which pages to publish.
#
#	 @param $web the web to publish
#	 @param $topic topic that was selected
#

sub chooseTopicScreen {
	
	my ($web, $topic) = @_;
	
	# Write HTTP headers.
	
	&TWiki::writeHeader($query);
	
	# Render publish confirm screen.
	
	my $tmpl = &TWiki::Store::readTemplate("publish");
	$tmpl = &TWiki::handleCommonTags($tmpl, $topic, $web);
	$tmpl = &TWiki::getRenderedVersion($tmpl);
	$tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
	$tmpl = &TWiki::handleCommonTags($tmpl, $topic, $web);	
	
	print $tmpl;
	
}


# ******************************************************************************
#
#	Publish the contents of one web.
#
#	@param $web which web to publish
#	@param $topic topic that was selected
#	@param $inclusions REs describing which topics to include
#	@param $exclusions REs describing which topics to exclude
#
#	@return 1 if succeeded; 0 if failed (will have redirected to error page)

sub publishWeb {

	my ($web, $topic, $inclusions, $exclusions) = @_;

	# Get list of topics from this web.

	my @topics = &TWiki::Func::getTopicList($web);

	# Parse list of includes/excludes.

	$inclusions = ".*" unless (defined ($inclusions));
	my @include = split( /[\r\n]+/, $inclusions );

	$exclusions = "Web.*" unless (defined ($exclusions));
	my @exclude = split( /[\r\n]+/, $exclusions );

	# Choose skin.

	my $skin = $query->param("skin") || &TWiki::Prefs::getPreferencesValue("SKIN");

	# Make sure appropriate directories exist. Create them if they don't.

	print "mkdir $publishDir\n" if ($debug);
	mkdir "$publishDir", 0777;

	if (!-d "$publishDir") {
		print "FAIL: $publishDir didn't get created\n" if ($debug);
		&TWiki::redirect($query, &TWiki::getOopsUrl($web, $topic, "oopspublisherr"));
		return 0;
	}

	if (!$noWebDir) {
		print "mkdir $publishDir/web\n" if ($debug);
		mkdir "$publishDir/$web", 0777;

		if (!-d "$publishDir/$web") {
			print "FAIL: $publishDir/web didn't get created\n" if ($debug);
			&TWiki::redirect($query, &TWiki::getOopsUrl($web, $topic, "oopspublisherr"));
			return 0;
		}

	}

	# Attempt to render each included page.

	my %copied;
	foreach my $topic (@topics) {
		&publishTopic($web, $topic, $skin, \%copied) if (&_inSet($topic, @include) && !&_inSet($topic, @exclude));
	}

	return 1;
	
}


# ******************************************************************************
#
#	Publish one topic from web.
#
#	@param $web which web to publish
#	@param $topic which topic to publish
#	@param $skin which skin to use
#   @param \%copied map of copied resources to new locations
#

sub publishTopic {

	my ($web, $topic, $skin, $copied) = @_;

	print "\npublishTopic($web, $topic, $skin, ...) $blah\n" if ($debug);

	# Used to set the topic when traversing the web.
	# THIS IS NASTY - but I can't find any other reliable way
	# to force TWiki to change topic.

    my $thePathInfo = $query->path_info(); 
    my $theRemoteUser = $query->remote_user();
    my $theUrl = $query->url;

	my ($itopic, $iweb, $iscriptUrlPath, $iuserName, $idataDir) =
		&TWiki::initialize($thePathInfo, $theRemoteUser, $topic, $theUrl, $query);

	die "Bad re-init (web = $iweb, should be $web)\n" if ($iweb ne $web);
	die "Bad re-init (topic = $itopic, should be $topic)\n" if ($itopic ne $topic);

	# Choose template.

	print "  Read template$blah\n" if ($debug);

	my $tmpl = &TWiki::Store::readTemplate("view", $skin);
	die "Couldn't find template\n" if(!$tmpl);	# FIXME should have an oops template...
	
	# Read topic data.

	print "  Read topic$blah\n" if ($debug);

	my ($meta, $text) = &TWiki::Store::readTopic($web, $topic);
	my ($revdate, $revuser, $maxrev) = &TWiki::Store::getRevisionInfoFromMeta($web, $topic, $meta, "isoFormat");
	$revuser = &TWiki::userToWikiName($revuser);

	# TO DO: Check page permissions.

	print "  Check page permissions$blah\n" if ($debug);

	# Swap in revision info.
	# [scouten 12/08/02]: Omit revision number and author.

	my $shortRevDate = &TWiki::getRenderedVersion("$revdate GMT");
	$shortRevDate =~ s( \- \d\d:\d\d GMT)()o;
	$tmpl =~ s/%REVINFO%/$shortRevDate/go;

	# Handle standard formatting.

	print "  Handle standard formatting (text)$blah\n" if ($debug);
	$text = &TWiki::handleCommonTags($text, $topic);
	$text = &TWiki::getRenderedVersion($text);

	print "  Handle standard formatting (topic)$blah\n" if ($debug);
	$tmpl = &TWiki::handleCommonTags($tmpl, $topic);
	$tmpl = &TWiki::handleMetaTags($web, $topic, $tmpl, $meta, 1);

	print "  Handle standard formatting (meta)$blah\n" if ($debug);
	#print "--- \$tmpl:\n$tmpl\n\n";
	#print "--- \$meta:\n";

	#foreach my $key (sort keys %$meta) {
		#print "  $key > $meta->{$key}\n";
	#}

	#print "\n\n----\n\n$blah";
	$tmpl = &TWiki::getRenderedVersion($tmpl, "", $meta); ## better to use meta rendering?

	print "  Merge content$blah\n" if ($debug);
	$tmpl =~ s/%TEXT%/$text/go;
	$tmpl =~ s/%MAXREV%/1.$maxrev/go;
	$tmpl =~ s/%CURRREV%/1.$maxrev/go;
	$tmpl =~ s/%REVTITLE%//go;
	$tmpl =~ s|( ?) *</*nop/*>\n?|$1|gois;	 # remove <nop> tags (PTh 06 Nov 2000)

	# Strip unsatisfied WikiWords.

	my $ult = &getUnsatisfiedLinkTemplate($web);
	$tmpl =~ s/$ult/$1/g;

	# Copy files from pub dir to rsrc dir in static dir.

	print "  Copy files $blah\n" if ($debug);

	$tmpl =~ s((?<==\")(?:http://localhost)?$webPubUrlPath\/([^\"]+)(?=\"))(&copyResource($web, $1, $copied))geo;

	# Modify internal links.

	print "  Update internal links $blah\n" if ($debug);

	my $ilt = &getInternalLinkTemplate($web, $topic);
	$tmpl =~ s/$ilt/<a href="$1.html$2"$3>$4<\/a>/g;

	# Scrap anything inside <nopublish> elements.

	print "  Scrap <nopublish> $blah\n" if ($debug);

	$tmpl =~ s(<nopublish>.*?<\/nopublish>)()gos;

	# Remove base tag  - DZA
	$tmpl =~ s/<base[^>]+\/>//;
	# Fix some links - DZA
	$tmpl =~ s!<a href=\"(?:http://localhost)?/bin/view/$web/!<a href=\"!go;
	$tmpl =~ s!<a href=\"(?:http://localhost)?/bin/view/([/A-Za-z0-9_]+)((\#[^\"]+)?)\"!<a href=\"../$1.html$2\"!go;
	
	# Insert .html in internal links.

	print "  Insert .html in internal links $blah\n" if ($debug);

	$tmpl =~ s/href=\"([A-Za-z0-9_]+)((\#[^\"]+)?)\"/href=\"$1.html$2\"/go;

	# Write the resulting HTML.

	print "  Write HTML $blah\n" if ($debug);

	my $htmlPath = $noWebDir ? "$publishDir$topic.html" : "$publishDir$web/$topic.html";
	open HTML, ">$htmlPath" or die "Couldn't open $htmlPath for write\n";
	print HTML $tmpl;
	close HTML;

	print "  Done $blah\n" if ($debug);

}


# ******************************************************************************
#
#	Copy a resource (image, style sheet, etc.) from twiki/pub/%WEB% to
#   static HTML's rsrc directory.
#
#   @param $web name of web
#   @param $rsrcName name of resource (relative to pub/%WEB%)
#   @param \%copied map of copied resources to new locations
#

sub copyResource {

	my ($web, $rsrcName, $copied) = @_;

	# See if we've already copied this resource.

	if (exists $copied->{$rsrcName}) {

		print "    Skip resource $rsrcName -- already copied$blah\n" if ($debug);

	} else {

		print "    Copy resource $rsrcName $blah\n" if ($debug);

		# Nope, it's new. Gotta copy it to new location.
		
		# Split resource name into path (relative to pub/%WEB%) and leaf name.
		
		my $file = $rsrcName;
		$file =~ s(^(.*)\/)()o;
		
		my $path = "";
		if ($rsrcName =~ "/") {
			$path = $rsrcName;
			$path =~ s(\/[^\/]*$)()o;
		}

		# Make sure target path exists.

		my $destPath = $noWebDir ? "$publishDir\rsrc/$path" : "$publishDir$web/rsrc/$path";
		$destPath =~ s/\/$//o;
		mkpath($destPath, 0, 0777);
		
		# Copy resource to rsrc directory.
		
		my $destFile = "$destPath/$file";
		File::Copy::copy("$webPubDir/$rsrcName", $destFile) or die "Failed to copy $file to $destFile\n";

		# Record copy so we don't duplicate it later.

		# my $destURL = $noWebDir ? "$publishUrlPath\rsrc/$path/$file" : "$publishUrlPath$web/rsrc/$path/$file";
		my $destURL = "rsrc/$path/$file";
		$destURL =~ s(//)(/)go;
					   
		$copied->{$rsrcName} = $destURL;
		
	}

	return $copied->{$rsrcName};
	
}


# ******************************************************************************
#
#	Return 1 if $topic is in @set.
#

sub _inSet {

	my ($topic, @set) = @_;

	foreach my $item (@set) {
		return 1 if ($item ne "" && $topic =~ /^$item/);
	}

	return 0;

}


# ******************************************************************************
#
#	Returns a pattern that will match the HTML used by TWiki to represent an
#	unsatisfied link. THIS IS NASTY, but I don't know how else to do it.
#

sub getUnsatisfiedLinkTemplate {

	my ($web) = @_;

	my $t = "!£%^&*(){}";# must _not_ exist!

	my $linkFmt = &TWiki::internalLink("", $web, $t, "TheLink", undef, 1);
	$linkFmt =~ s/\//\\\//go;

	my $pre = $linkFmt;
	$pre =~ s/TheLink.*//o;

	my $post = $linkFmt;
	$post =~ s/.*TheLink//o;
	$post =~ s/\"[^\"]*\"/\"[^\"]*\"/o;
	$post =~ s/\?/\\?/o;

	return $pre . "(.*?)" . $post;

}


# ******************************************************************************
#
#	Returns a pattern that will match the HTML used by TWiki to represent an
#	internal link. THIS IS NASTY, but I don't know how else to do it.
#

sub getInternalLinkTemplate {

	my ($web, $topic) = @_;

	my $linkFmt = &TWiki::internalLink("", $web, $topic, "TheLink", undef, 1);
	$linkFmt =~ s/$web\/$topic/$web\/([^"#]*)([^"]*)/g;
	$linkFmt =~ s/\//\\\//go;
	$linkFmt =~ s/>TheLink/([^>]*?)>(.*?)/go;

	return $linkFmt;

}