#!/usr/bin/perl
print "Content-type: image/svg-xml\n\n";
#print "Content-type: text/html\n\n";

use strict;
use lib ( '.' );
use lib ( '../lib' );
use TWiki;
use GraphViz;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use MLDBM qw(DB_File Storable);
use Fcntl;

my %links = ();
my %revlinks = ();

my $query = new CGI;
my $theTopic = $query->param( 'topic' ) || "";
my $theWeb = $query->param( 'web' ) || "";
my $force = $query->param( 'force' ) || "no";
my $debug = 0;

if( $theWeb ) {
    # do a particular web:
    loadLinks($theWeb, $force);
    print processLinks($theTopic, $theWeb);
} else {
    # do all webs:
    my $dataDir = &TWiki::getDataDir();
    my @weblist = ();
    if( opendir( DIR, "$dataDir" ) ) {
        @weblist = grep /^[^\.\_]/, readdir DIR; # exclude webs starting with . or _
        closedir DIR;
    } else {
        printMsg( "  *** Error: opendir $dataDir, $!" );
    }
    my $webName = "";
    
    foreach $webName ( @weblist ) {
        if( -d "$dataDir/$webName" ) {
        	print "processing: $webName\n";
        	loadLinks("$webName", "yes");
              # processWeb( "/$web", $theRemoteUser, $theTopic, $logMonthYear, @logList );
        }
    }
}

exit;

sub readFile
{
    my( $name ) = @_;
    my $data = "";
    undef $/; # set to read to EOF
    open( IN_FILE, "<$name" ) || return "";
    $data = <IN_FILE>;
    $/ = "\n";
    close( IN_FILE );
    $data = "" unless $data; # no undefined
    return $data;
}

sub saveFile
{
    my( $name, $text ) = @_;
    
    umask( 002 );
    open( FILE, ">$name" ) or warn "Can't create file $name\n";
    print FILE $text;
    close( FILE);
}

sub loadLinks()
{
	my ($web, $force) = @_;
	my $linksFilename = $TWiki::tempDir . "/links_$web.dat";
	my $revlinksFilename = $TWiki::tempDir . "/revlinks_$web.dat";
	my $createdLinksFileName = $TWiki::tempDir . "/created_$web.dat";

	if (-e "$createdLinksFileName" && ($force ne "yes"))
	{
		my $lockTime =  readFile($createdLinksFileName);
		my $systemTime = time();
	
		$lockTime = $lockTime + $TWiki::graphVizTime - $systemTime;
		if( $lockTime <= 0)
		{
			generate($web);
			saveLinks($web);
		}
        	}
        	else
        	{
        		%links = ();
        		%revlinks = ();
        		generate($web);
        		saveLinks($web);
        	}
        	
	tie my %linksFile, 'MLDBM' ,"$linksFilename", O_RDWR|O_CREAT, 
	    0660 or die "Can't tie $linksFilename: $!";
	   
	tie my %revlinksFile,  'MLDBM',"$revlinksFilename" , O_RDWR|O_CREAT, 
	   0660 or die "Can't tie $revlinksFilename: $!";
	   
	%links = %linksFile;
	%revlinks =  %revlinksFile;
	   
	untie %linksFile;
	untie %revlinksFile;	   
}

sub saveLinks()
{
	my ($web) = shift;

	my $linksFilename = $TWiki::tempDir . "/links_$web.dat";
	my $revlinksFilename = $TWiki::tempDir . "/revlinks_$web.dat";
	my $createdLinksFileName = $TWiki::tempDir . "/created_$web.dat";
	
 	tie my %linksFile , 'MLDBM',"$linksFilename", O_RDWR|O_CREAT, 
	   0660 or die "Can't tie $linksFilename: $!";
   
	tie my %revlinksFile ,  'MLDBM',"$revlinksFilename" , O_RDWR|O_CREAT, 
	   0660 or die "Can't tie $revlinksFilename: $!";

	%linksFile = %links;
	%revlinksFile = %revlinks;	   
	
	untie %linksFile;
	untie %revlinksFile;
	
	saveFile($createdLinksFileName, time());
}

sub processLinks()
{
	my ($startNode) = shift;
	my ($web) = shift;
	
	my @linksFromStart = unique( keys(%{$links{$startNode}}), keys(%{$revlinks{$startNode}}) );
	
	my $wiz = GraphViz->new( directed => 0, no_overlap => 1);
	$wiz->add_node($startNode, style => 'bold', color => 'red');
	
	foreach my $node ( @linksFromStart ) {
	    $wiz->add_node($node);
	    $wiz->add_edge($startNode => $node);
	
	    my @links = unique( keys(%{$links{$node}}), keys(%{$revlinks{$node}}) );
	    
	    foreach my $node2 ( @links ) {
		$wiz->add_node($node2);
		$wiz->add_edge($node => $node2);
	
	    }
	}
	
	my $output = $wiz->as_svg;
	
	# post processing: add viewBox to SVG source
	$output =~ s/^(<svg\s+width="(.*?)px"\s+height="(.*?)px")$/$1 viewBox="0 0 $2 $3"/m;
	# post processing: make nodes linked
	$output =~ s!(<g\sid=\"node.*?<text[^>]*>(.*?)</text>.*?</g>)!makeSvgLink($web, $1,$2)!egs;

	return $output;
}

sub generate()
{
	my ($web) = @_;
	
	# names of topics to skip (^Web is assumed). this is so that
	# topics like WebIndex and WebTopicList don't end up in every map
	my $skip = 'Home|Notify|Changes|TopicList|Index|Statistics|Preferences|TopicEditTemplate|Search';
	
	# get the topics for the web
	my @topics = TWiki::Func::getTopicList($web);
	
	# look for links in each topic
	foreach my $topic ( @topics ) {
	    # skip specified topics
	    print "$topic\n" if $debug;
	    next if ( $topic =~ /^Web(?:$skip)$/ );
	    
	    # grab the page source
	    my $rawPage = TWiki::Func::readTopic($web, $topic);
	
	    # strip META info
	    $rawPage =~ s/%META[^%]%//mg;
	    # $rawPage =~ s/%SEARCH\{([^\}]*)\}%/TWiki::handleSearchWeb($1.qq[ web="$web"])/emg;
	
	    # expand the variables in the page
	    my $expandedPage = TWiki::Func::expandCommonVariables($rawPage, $topic, $web);
	    # parse out the links
	    my @linksWeb = findLinks($web, $topic, $expandedPage);
	    
	    # add links to the lookup hashes
	    foreach my $target ( @linksWeb ) {
		next if ( $target eq $topic );
		next if ( $target =~ /^Web(?:$skip)$/ );
		
		print "-->\t$target\n" if $debug;
	
		if ( TWiki::Func::topicExists($web, $target) ) {
		    $links{$topic}->{$target} = 1;
		    $revlinks{$target}->{$topic} = 1;
		}
	    }
	}
}


sub makeSvgLink() {
    my $web = shift;
    my $xml = shift;
    my $text = shift;

    return qq[<a xlink:href="$TWiki::scriptUrlPath/view$TWiki::scriptSuffix/$web/$text">$xml</a>];
}

sub unique {
    my %seen;
    return grep { ! $seen{$_} ++ } @_;
}


sub parseWikiLink {
    my $link = shift;
    return if ( $link =~ /^http/ );

    $link =~ s/[^A-Za-z0-9]+//g;
    return $link;
}

sub findLinks {
    my ($web, $topic, $page) = @_;
    my @links;

    # regexes nabbed from TWiki::getRenderedVersion()

    # '[[Web.odd wiki word#anchor][display text]]' link:
    while ( $page =~ /\[\[([^\]]+)\]\[([^\]]+)\]\]/mg ) {
	if ( my $link = parseWikiLink($1) ) {
	    #print STDERR "found type 1 [$link]\n";
	    push @links, $link;
	}
    }

    # '[[Web.odd wiki word#anchor]]' link:
    while ( $page =~ /\[\[([^\]]+)\]\]/mg ) {
	if ( my $link = parseWikiLink($1) ) {
	    #print STDERR "found type 2 [$link]\n";
	    push @links, $link;
	}
    }

    while ( $page =~ m|cgi-bin/twiki/bin/view/([A-Za-z0-9]+)/([A-Za-z0-9]+)|mg ) {
	if ( my $link = parseWikiLink($2) ) {
	    #print STDERR "found type 3 [$link]\n";
	    push( @links, $link ); 
	}
    }

    # 'TopicName' link:
    while ( $page =~ /(?:[\s\(])([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/mg ) {
	#print STDERR "found type 4 [$1]\n";
	push( @links, $1 ); 
    }

    return @links;
}