#!/usr/bin/perl -w
#
# @(#)$Id: tgdb,v 1.1 2002/10/09 22:14:30 baron Exp $ (c) Peter Klausner 2002
#

# customize...
$touchgraph = "touchgraph.txt";
$viewprefix = "$TWiki::defaultUrlHost$TWiki::scriptUrlPath/view$TWiki::scriptSuffix";
$attach = "$TWiki::defaultUrlHost$TWiki::pubUrlPath";
$defaultparent = "WebHome";

use lib ( '.' );
use lib ( '../lib' );
use TWiki;
use TWiki::Net;
use Getopt::Std;

# options...
$opt_d = 0;			# (d)ebug
$opt_q = 0;			# (q)uit
#
getopt("dq");


&main();

sub main
{
    print "Content-type: text/plain

TWiki $touchgraph list generation
- to suppress all normal output: $0 -q\n" unless $opt_q;

    my $dataDir = &TWiki::getDataDir();
    if ( @ARGV )	{
	@weblist = @ARGV;
    }
    else {
	opendir( DIR, "$dataDir" ) or die "could not open $dataDir";
	@weblist = grep !/^\.\.?$/, readdir DIR;
	closedir DIR;
    }
    foreach $web ( @weblist ) {
        
	# christo: _default is no real web ...
        # maybe we don't need to process Trash as well?
        processWeb( $web ) if ( -d "$dataDir/$web" and $web ne '_default');
    }
    print "End create $touchgraph\n" unless $opt_q;
}

sub processWeb
{
    my( $web) = @_;

    my $file = "";
    my @filelist = ();
       %parent_child = ();	# global context for xrf()
       $the_topic = "";		#

    my ( $topic, $webName, $dummy, $userName, $dataDir) = 
	&TWiki::initialize( "/$web", "nobody" );
    $dummy = "";  # to suppress warning
    my $pubDir = TWiki::getPubDir();

    print "__________________________\nChecking TWiki.$webName\n" unless $opt_q;

    if( ! &TWiki::Store::webExists( $webName ) ) {
	print STDERR "* ERROR: TWiki $0 does not find web $webName\n";
	return;
    }

    opendir( DIR, "$dataDir/$web" ) or die "$dataDir/$web: $!";
    @filelist = grep /^.*\.txt$/, readdir DIR;
    closedir DIR;

    foreach $file ( sort @filelist ) {
        
	$file =~ s/.txt$//;
	$the_topic = $file;
        processTopic( $dataDir, $web, $file )	if ( -d "$dataDir/$web" );
    }

    # christo: check if pub/$web exists
    if (! -d "$pubDir/$web/") { 
	if (! mkdir "$pubDir/$web/") {
	    warn "could not make $pubDir/$web/ $!";
	    return;
	};
    }

    # christo: warn instead of die
    if (! open LIST, ">$pubDir/$web/$touchgraph") {
	warn "$web/$touchgraph: $!";
	return;
    }

    print "\n$web/$touchgraph... ";
    foreach my $p (sort keys %parent_child)
    {
	print LIST "\n$p";
        foreach my $c (sort keys %{$parent_child{$p}})
	{
	    print LIST " $c"	unless ($p eq $c);
	}
    }
    close LIST or die "close $web/$touchgraph: $!";
    print " written.\n" unless $opt_q;
}

sub xrf # child [parent-if-not-current-topic]
{
	my $child  = defined($_[0]) ? $_[0] : "";
	my $parent = defined($_[1]) ? $_[1] : $the_topic;

	if (! ($child =~ /^http/ )) {	# verify local twiki links...
		if (! -f "$TWiki::dataDir/$web/$child.txt") {
			$child =~ s/s$//;	# twikis plural links
			if (! -f "$TWiki::dataDir/$web/$child.txt") {
				return "";
			}
		}
	}
	$child and $parent and $parent_child{$parent}{$child} = 1;
	if (! $opt_q )	{
	    if ( $parent eq $the_topic ) { print "	-> $child\n"; }
	    else 			 { print "	<- $child\n"; }
	    print "	//$_" if $opt_d;
	}
	return "";
}

sub processTopic
{
    my ($dataDir, $web, $topic) = @_;
    my $hasparent = 0;

    print "\n$topic...\n" unless $opt_q;
    open TOPIC, "$dataDir/$web/$topic.txt" or die "$web/$topic: $!";
    while (<TOPIC>)
    {
	s/%TWIKIWEB%/TWiki/go;
	s/%MAINWEB%/Main/go;
	# meta stuff
	if (/^%META:TOPICPARENT.name="(.*)"/o) {
	    				xrf $topic, $1; $hasparent = 1; next; }
	m/^%META:FORM.name="(.*)"/o and
	   				xrf $topic, $1 and next;
	m/^%META:TOPICINFO.author="([^"]*)/o and
	   			xrf $topic, "$viewprefix/Main/$1" and next;
	m/^%META:FILEATTACHMENT.name="([^"]*)\.(htm|html|txt)/o	and
				xrf "$attach/$web/$topic/$1";
	s/^%META:FIELD.*title="([^"]+).*value="([^"]+)/ $1 \n $2 /o and next;
	m/^%META:/o	and next;
							#vi{
	##s/%INCLUDE."*([^"}]+)//go	and	xrf $1;
		
	s/[#:<>{}()][A-Z]+[a-z]+[A-Z][A-Za-z0-9_-]*//go; #discard some wikiwords

	# links with web
	s/\[\[+([A-Z][A-Za-z]+)[.]([A-Z]+[a-z]+[A-Z][A-Za-z0-9_-])\]+//o and
						xrf "$viewprefix/$1/$2";
	s/\b([A-Z][A-Za-z]+)[.]([A-Z]+[a-z]+[A-Z][A-Za-z0-9_-]*)//o and
						xrf "$viewprefix/$1/$2";
	# normal links
	s/\[\[+([^]]+)\]/&xrf($1)/geo;
	s/\b[A-Z]+[a-z]+[A-Z][A-Za-z0-9_-]*/&xrf($&)/geo;
	# external links
	s/(^|href=|\s)(http:\/\/[^]> "\n	]+)/&xrf($2)/geo;
	s/\b([A-Z][A-Z][A-Z]+)\W/&xrf("$1")/geo;
    }
    xrf $topic, $defaultparent	unless ($hasparent);
}