#!/usr/bin/perl -w -I.
#
# TWiki WikiClone (see $wikiversion in wiki.pm for version)
#
# Copyright (C) 2000 Sterbini, Andrea a.sterbini@flashnet.it
#
# 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.ai.mit.edu/copyleft/gpl.html 
#
######################################################################
#
# This cgi script produces a "dot" file describing the links in a Web
# The "dot" file can be used by webdot (with the help of graphviz)
# to produce a nice clickable map of the web
#
######################################################################
#
# TODO: show also html links
#
######################################################################

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use lib ( '.' );
use lib ( '../lib' );
#use Data::Dumper;
use TWiki;

#do "wikicfg.pm";

$query = new CGI;

#open(STDERR,'>&STDOUT'); # redirect error to browser   # comment
$| = 1;                  # no buffering
#print "Content-type: text/plain \n\n";                 # comment

#use vars qw($excludeWeb);

&main();

sub main
{

    #FIXME: move to wikicfg.pm or find a way to put it in the URL
    #uncomment next line if you don't want users/groups in your graph
    my $excludeWeb = "$TWiki::mainWebname";
    print STDERR "excludeweb " . $excludeWeb . '\n';
    #$excludeWeb = "";

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

    my ( $topic, $webName, $scriptUrlPath, $userName ) = 
	&TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl );
    
    $webName = $query->path_info();

    # get the web name by removing the file extension
    $webName =~ s/^\/?(.*)\.dot$/$1/oi ;

    if( ! &TWiki::Store::webExists( $webName ) ) {
        $tmpl= &TWiki::Store::readTemplate( "noweb" );
        $tmpl = &TWiki::handleCommonTags( $tmpl, $topic );
	    print "Content-type: text/html \n\n";
        print $tmpl;
        return;
    }

    my $tempVal = "";
    my $tmpl = &TWiki::Store::readTemplate( "webmap" );
    $tmpl = &TWiki::handleCommonTags( $tmpl, $topic );
    my( $tmplHead, 
	$tmplTopic, 
	$tmplEndTopics, 
	$tmplExternalHeader, 
	$tmplExternalTopicWeb,
	$tmplExternalTopic,
	$tmplExternalEnd,
        $tmplLinkHeader,	
        $tmplLink,	
        $tmplParentChildHeader,
        $tmplParentChild,
	$tmplEnd
	) = split( /<SPLIT>/oi, $tmpl );

# here follows a mimimum template
#// header
#    digraph "<webName/>" {
#	URL     = "%SCRIPTURLPATH%/view%SCRIPTSUFFIX%/\N"
#    //    color=<webColor/>
#<split> // topic
#    "<topicName/>"
#<split> // endtopic
#<split> // external web header
#    subgraph "cluster<webName/>" {
#    //	color    = <webColor/>
#    //	label    = "<webName/>"
#        URL      = "%SCRIPTURLPATH%/view%SCRIPTSUFFIX%/\N"
#<split> // external web link
#    "<webName/>/WebMap" [label="<webName/>" shape=ellipse]
#<split> // external topic link
#    "<webName/>/<topicName/>" [label="<topicName/>"]
#<split> // end external
#<split> // link
#    "<fromName/>" -> "<toName/>"
#<split> // end graph

#    $tmplHead	= &TWiki::handleCommonTags( $tmplHead, $topic );

    if( ! $tmplEnd ) {
        print "<html><body>";
        print "<h1>TWiki Installation Error</h1>";
        print "Incorrect format of webmap.tmpl (missing &lt;SPLIT> parts)";
        print "</body></html>";
        return;
    }

    my $webColor = &getWebColor($webName);

    my @topicList = &TWiki::Store::getTopicNames($webName);

    # find last modification date (should I use .changes instead?)
    my @dates =	sort { $b <=> $a }
                map  { (stat "$TWiki::dataDir\/$webName\/$_.txt")[9] }
                @topicList;

    # with this line webdot computes the image ONLY if something changes
    # in this web
    print "Last-Modified: " . (scalar localtime $dates[0]) . "\n";

    print "Content-type: text/plain \n\n";

    $tmplHead =~ s/<webName\/>/$webName/goi;
    $tmplHead =~ s/<webColor\/>/$webColor/goi;

    print $tmplHead;

#    print 
#"digraph \"$webName\" \{
#concentrate = true
#graph [
#    rankdir = LR
#    nodesep = 0.1
#    ]
#node [
#    URL     = \"$wiki::scriptUrlPath/view$wiki::scriptSuffix/$webName/\\N\"
#//    style   = box
#    height  = 0
#    width   = 0
#    color   = $webColor
#    fontsize= 11
#    fontname= Helvetica
#    shape   = box
#    ]
#//subgraph \"cluster$webName\" \{
#//graph [
#//    color=$webColor
#//    label=\"$webName\"
#//    fontsize=20
#//    ]
#";

    my @found = ();
    my %externalTopics = ();
    my %allTopicsLinks = ();
    my @topicLinks = ();
    my $text = "";
    my @links = ();
    my @hrefs = ();
    foreach $topic (@topicList) {
	my $tmpTxt = "$tmplTopic";
        $validTopic{$topic}=1;
	$tmpTxt =~ s/<topicName\/>/$topic/goi;
print	$tmpTxt;
#	print 
#"\"$topic\"
#";
	if (! exists $allTopicLinks{$topic}) {
	    $allTopicLinks{$topic} = [];
	}
	$topicLinks = $allTopicLinks{"$topic"};

	&TWiki::initialize( $thePathInfo, $theRemoteUser, $topic, $theUrl );
	$text = &TWiki::Store::readWebTopic("$webName","$topic");

	# FIXME: should we completely render the page?
#	$text = &TWiki::handleCommonTags($text, $topic, $webName);
	
	@links = sort
		grep {  /^(\Q$webName\E(\.|\/)|([A-Z][a-zA-Z0-9]+(\.|\/))+)?([A-Z][a-z]+[A-Z][a-zA-Z0-9]*)[\,\.\?!]?$/ }
		split ( /[\n\s\t\|]/ , $text);
	# FIXME: should we collect also href links? (yes, how? needs foundLinkHandler )
#	@hrefs =sort
#		grep {  /^.*<a href=\".*\">.*$/io }
#		split ( /[\n\s\t\|]/ , $text);
#	@links = (@links, @hrefs);
	my @lista = ();
	foreach $link (@links) {
#	    $link =~ s/^.*$wiki::scriptUrlPath\/view$wiki::scriptSuffix\/(.*)\">.*$/$1/o ;
	    $link =~ s/^(\Q$webName\E(\.|\/))?([A-Z][a-z]+[A-Z][a-zA-Z0-9]*)[\,\.\?!]?$/$3/o ;
	    $link =~ s/^(.+)(\.|\/)([A-Z][a-z]+[A-Z][a-zA-Z0-9]*)[\,\.\?!]?$/$1\/$3/o ;
	    $link =~ s/\./\//go ;
	    $link =~ s/\/\//\//go ;
	    @found = grep { /^\Q$link\E$/ } @$topicLinks;
	    if ( $#found ) {
	#	push @$topicLinks, ("$link") ;
		# collect links to other webs
		if ( $link =~ /^(.+)\/([A-Z][a-z]+[A-Z][a-zA-Z0-9]*)$/ ) {
		    if ($1 ne $excludeWeb) {
			if (! exists $externalTopics{"$1"}) {
			    $externalTopics{"$1"} = [];
			}
		        push @$topicLinks, ("$link") ;
			$lista = $externalTopics{"$1"};
			@found = grep { /^\Q$2\E$/ } @$lista;
			if ($#found) {
			    push @$lista, ("$2");
			}
#                      print STDERR "DEBUG $topic -> $link \n";
		    }
                    else
                    {
                      1; #print STDERR "DEBUG EXCLUDED\n";
                    }
		}
                else
                {
#                print STDERR "DEBUG $topic -> $link \n";
		push @$topicLinks, ("$link") ;
                }
	    }
	}
    }

    #TODO: handle some tags
    print $tmplEndTopics;
#print 
#"//}
#";

    foreach $web (sort keys %externalTopics) {
	if ($web ne $excludeWeb) {
	    $webColor = getWebColor($web);

	    my $tmpTxt = "$tmplExternalHeader";
	    $tmpTxt =~ s/<webName\/>/$web/goi;
	    $tmpTxt =~ s/<webColor\/>/$webColor/goi;
	    print	$tmpTxt;

#	print 
#"	subgraph \"cluster$web\" \{
#	graph [
#//	    shape    = box
#//          color    = $webColor
#//          label    = \"$web\"
#//          fontsize = 14
#    	    color    = white
#            ]
#        node [
#            color    = $webColor
#            URL      = \"$wiki::scriptUrlPath/view$wiki::scriptSuffix/\\N\"
#            ]
#";
	    my @lista = sort @{$externalTopics{$web}};
	    foreach $link (@lista) {
		if ($link eq $TWiki::mainTopicname)
		{
		    $tmpTxt = "$tmplExternalTopicWeb";
#		print 
#"	\"$web/WebMap\" [label=\"$web\" shape=ellipse]
#";
		} else {
		    $tmpTxt = "$tmplExternalTopic";
#		print 
#"	\"$web/$link\" [label=\"$link\"]
#";
		}

		$tmpTxt =~ s/<topicName\/>/$link/goi;
		$tmpTxt =~ s/<webName\/>/$web/goi;
		$tmpTxt =~ s/<webColor\/>/$webColor/goi;
		print	$tmpTxt;
	    }
	    print $tmplExternalEnd;
#	print 
#"	}
#";
	}
    }
    print $tmplLinkHeader;
    foreach $topic (sort keys %allTopicLinks) {
	my @lista = sort @{$allTopicLinks{$topic}};
	foreach $link (@lista) {
	    $tmpTxt = "$tmplLink";
	    $tmpTxt =~ s/<fromName\/>/$topic/goi;
	    $tmpTxt =~ s/<toName\/>/$link/goi;
	    $tmpTxt =~ s/<webName\/>/$webName/goi;
	    $tmpTxt =~ s/<webColor\/>/$webColor/goi;
            if ( !($topic eq $link) && $validTopic{$link} )
#            if ( !($topic eq $link) )
            {
	       print	$tmpTxt;
            }
#	    print 
#"\"$topic\"->\"$link\"
#";
	}
    }
    #
    # Handle the links for parent child relationships
    print $tmplParentChildHeader;
    foreach $topic (sort keys %allTopicLinks) {
	$tmpTxt = "$tmplParentChild";
        $parent = getParent($webName,$topic);
#        print STDERR "// webname=$webName topic=$topic parent=$parent\n";
        if ( $parent )
        {
	  $tmpTxt =~ s/<childName\/>/$topic/goi;
	  $tmpTxt =~ s/<parentName\/>/$parent/goi;
	  print	$tmpTxt;
        }
    }

	print $tmplEnd;
#    print 
#"}
#";

    return;
}

sub getParent
{
    my ($webName, $topicName) = @_;
    my ($meta, $text) = &TWiki::Store::readTopic( $webName, $topicName );
    my %parent = $meta->findOne( "TOPICPARENT" );
#    print STDERR Dumper(\%parent);
    return $parent{name};
}

#=================================================
sub getWebColor
{ 
    my ($webName) = @_;

    &TWiki::Prefs::initializePrefs("guest",$webName);
    my $webColor = &TWiki::Prefs::getPreferencesValue("WEBBGCOLOR", $webName) || "gray" ;

    if ($webColor =~ /\#[0-9A-F]{6}/i ) {
	$webColor =~ s/#([0-9A-F][0-9A-F])([0-9A-F][0-9A-F])([0-9A-F][0-9A-F])/"".&handleColor($1)." ".&handleColor($2)." ".&handleColor($3).""/ei ;

	my @hsb = rgb2hsb( split( / /, $webColor));
	$webColor = join " ", @hsb;
    }
    return $webColor;
}

sub handleColor
{
    my ($hexColor) = @_;
    return eval("0x$hexColor");

}

#=====================================================================
# thanks a lot to ManpreetSingh for the colour conversion code!
sub maxof {
   my ($a, $b) = @_;
   
    return $a>$b?$a:$b;
}
      
sub minof {
    my ($a, $b) = @_;
	 
    return $a<$b?$a:$b;
}
	    
#  Converts rgb to hsb.  All numbers are within range 0 to 1
sub rgb2hsb {
    my ($r, $g ,$b) = @_;
    my ($h, $s, $br);
    my $max = maxof($r, maxof($g, $b));
    my $min = minof($r, minof($g, $b));
    $br = $max/255.0;

    if ($max > 0.0) {
	$s = ($max - $min) / $max;
    } else {
	$s = 0.0;
    }
    if ($s > 0.0) {
	my ($rc, $gc, $bc, $diff);
	$diff = $max - $min;
	$rc = ($max - $r) / $diff;
	$gc = ($max - $g) / $diff;
	$bc = ($max - $b) / $diff;
	if ($r == $max) {
	    $h = ($bc - $gc) / 6.0;
	} elsif ($g == $max) {
	    $h = (2.0 + $rc - $bc) / 6.0;
	} else {
	    $h = (4.0 + $gc - $rc) / 6.0;
	}
    } else {
	$h = 0.0;
    }
    if ($h < 0.0) {
	$h += 1.0;
    }
    return ($h, $s, $br);
}

1;
