#!/usr/local/bin/perl -w
##
## Copyright 2002 The Regents of the University of California
## All Rights Reserved
##
## Permission to use, copy, modify and distribute any part of this
## CoralReef software package for educational, research and non-profit
## purposes, without fee, and without a written agreement is hereby
## granted, provided that the above copyright notice, this paragraph
## and the following paragraphs appear in all copies.
##
## Those desiring to incorporate this into commercial products or use
## for commercial purposes should contact the Technology Transfer
## Office, University of California, San Diego, 9500 Gilman Drive, La
## Jolla, CA 92093-0910, Ph: (858) 534-5815, FAX: (858) 534-7345.
##
## IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
## PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
## DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS
## SOFTWARE, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF
## THE POSSIBILITY OF SUCH DAMAGE.
##
## THE SOFTWARE PROVIDED HEREIN IS ON AN "AS IS" BASIS, AND THE
## UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO PROVIDE MAINTENANCE,
## SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. THE UNIVERSITY
## OF CALIFORNIA MAKES NO REPRESENTATIONS AND EXTENDS NO WARRANTIES
## OF ANY KIND, EITHER IMPLIED OR EXPRESS, INCLUDING, BUT NOT LIMITED
## TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A
## PARTICULAR PURPOSE, OR THAT THE USE OF THE SOFTWARE WILL NOT INFRINGE
## ANY PATENT, TRADEMARK OR OTHER RIGHTS.
##
## Report bugs and suggestions to info@caida.org.
##
## This is a first pass at a perl function for writting libsea
## graphs.  It is not complete, but is a good starting place.
##
## written by Bradley Huffaker 
use strict;

####################################################################
#   Public function which produces a libsea graph based on the arguments
#   passed to it.
#
#   This function takes a single value which is a pointer to arguments
#   the user which to use.  There exist default values for all arguments.
#
#   Arguments
# -----------------------------------------------------------------
#
#   verbose - if this attribute is found LibSeaGraphWrite will 
#	    print extrea information in the graph which helps
#	    the graph's human readablity
#
#   nodes - this should be a pointer to hash which holds all the
#           attribute value for each node
#           $nodes{$name}{$attribute} = $value;
#   links - this should be a pointer to hash which holds all the
#           attribute value for each link.  From and To should
#           be the same names use in nodes.
#           $links{"$from\0$to"}{$attribute} = $value;
#   paths - this should be a pointer to hash which holds all the
#           attribute value for each path.  node names should be the
#           same as those used in nodes.
#           $paths{"node1\0node2\0$node2......."}{$attribute} = $value;
#
#   max num str colors - this is the max number of strings which will
#           get their own color.  Above this number colors will be
#           repeated.  If not give it assumes 10
#
#   filename - this is the filename that the graph will be printed
#           if this argument is not give it will be printed to
#           STDOUT
#
#   attributes - pointer to the list of attributes that objects
#           may have values for.  Only attributes listed here will
#           be included in the final graph.  Even if the some objects 
#	    have values for them.
#               title - title of the attribute used to find it in the
#		    objects hash
#               type - bool, string, int, float
#               color_type - this creates a new attribute which colors 
#		    the nodes by they type: hot_to_cold
#
#   qualifiers - pointer to a list of qualifiers
#           Each qualifier is a pointer to a hash function with
#           following values:
#               type - this provides the type of qualifier
#               name - name of the qualifier
#               attributes - list of attributes which are used
#                   bu this qualifier
####################################################################

## convent globals

    #   The max number of unique colors give to strings.
my $MAX_NUM_STR_COLORS;
    #	Filahandler pointer which will be printed to.
my $filehandle;

    # If this is defined it prints out extrea words
my $verbose;


    # These store the nodes, links and paths.
my %node2value;
my %link2value;
my %path2value;

    # This stores the nodes in ordered order
my @nodes_ordered;
my @links_ordered;
my @paths_ordered;

    # This stores the map between node -> id, link -> id
my %node2id;
my %link2id;
my %attribute2id;

sub LibSeaGraphWrite {
    my ($arguments) = @_;

    my @arrays = ( $arguments->{"nodes"}, $arguments->{"links"}, 
	$arguments->{"paths"} );

    if (defined $arguments->{"max num str colors"}) {
	$MAX_NUM_STR_COLORS = $arguments->{"MAX_NUM_STR_COLORS"};
    } else {
	$MAX_NUM_STR_COLORS = 10;
    }

    foreach my $i (0..$#arrays) {
	unless (defined $arrays[$i]) {
	    $arrays[$i] = {};
	}
    }

    my @arguments = ("name","description");
    my @values;
    foreach my $index (0..$#arguments) {
	my $argument = $arguments[$index];
	my $value = $arguments->{$argument};
	if (defined $value) {
	    $value =~ s/\"//g;
	    $values[$index] = $value;
	}
    }
    my ($name,$description) = @values;

    if (defined $arguments->{"filename"}) {
	my $filename = $arguments->{"filename"};
	open(FILEHANDLER, ">$filename") 
	    || die("Unalbe to open`$filename' for read:$!");
	$filehandle = \*FILEHANDLER;
    } else {
	$filehandle = \*STDOUT;
    }

    if (defined $arguments->{"verbose"}) {
	$verbose = 1;
    }

    %node2value = %{$arrays[0]};
    %link2value = %{$arrays[1]};
    %path2value = %{$arrays[2]};

    ## Set up also fills in the arrays above
    my ($num_nodes, $num_links, $num_paths, $num_pathLinks) = SetUp();
    print $filehandle "Graph\n";
    print $filehandle "{\n";
    print $filehandle "   \@name=" if (defined $verbose);
    print $filehandle "\"$name\";\n";
    print $filehandle "   \@description=" if (defined $verbose);
    print $filehandle "\"$description\";\n";
    print $filehandle "   \@numNodes=" if (defined $verbose);
    print $filehandle "$num_nodes;\n";
    print $filehandle "   \@numLinks=" if (defined $verbose);
    print $filehandle "$num_links;\n";
    print $filehandle "   \@numPaths=" if (defined $verbose);
    print $filehandle "$num_paths;\n";
    print $filehandle "   \@numPathLinks=" if (defined $verbose);
    print $filehandle "$num_pathLinks;\n";
    print_links();
    print_paths();
    print $filehandle "   \@enumerations=" if (defined $verbose);
    print $filehandle ";\n";
    print $filehandle "   \@attributeDefinitions=" if defined ($verbose);
    print $filehandle "[\n";

    if (defined $arguments->{attributes}) {
	my @attributes = @{$arguments->{attributes}};
	my $id = 0;
	foreach my $index ( 0..$#attributes) {
	    my ($title, $type, $color_type, $default) = (
		$attributes[$index]->{title},
		$attributes[$index]->{type},
		$attributes[$index]->{color_type},
		$attributes[$index]->{default}
		);
	    if ($index > 0) {
		print $filehandle ",\n";
	    }
	    $attribute2id{$title} = $id++;
	    print_attribute($title, $type, $default);

	    if (defined $color_type) {
		$id++;
		print $filehandle ",\n";
		print_attribute_to_color ($color_type, $title, $type);
	    }
	}
    }
    print $filehandle "\n";
    print $filehandle "   " if (defined $verbose);
    print $filehandle "];\n";
    print $filehandle "   \@qualifiers=" if (defined $verbose);
    print $filehandle "[\n";
    if (defined $arguments->{qualifiers}) {
	foreach my $i (0..$#{$arguments->{qualifiers}}) {
	    my $qualifier = $arguments->{qualifiers}->[$i];
	    print_qualifier($qualifier->{type}, $qualifier->{name},
		$qualifier->{attributes});
	    if ($i > 0) {
		print $filehandle ",\n";
	    } else {
		print $filehandle "\n";
	    }
	}
	print $filehandle "\n";
    }
    print $filehandle "   " if (defined $verbose);
    print $filehandle "];\n";
    print $filehandle "   \@filters=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@selectors=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@displays=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@presentations=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@presentationMenus=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@displayMenus=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@selectorMenus=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@filterMenus=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "   \@attributeMenus=" if defined ($verbose);
    print $filehandle ";\n";
    print $filehandle "}\n";

    close $filehandle;
}

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

sub SetUp {

    my $num_pathLinks = GetNumPathLinks();

    my %nodes;
    my %links;

    my $num_nodes = @nodes_ordered = keys %node2value;
    my $num_links = @links_ordered = keys %link2value;
    my $num_paths = @paths_ordered = keys %path2value;

    foreach my $node (@nodes_ordered) {
	$nodes{$node} = 1;
    }
    foreach my $link (@links_ordered) {
	my ($from, $to) = split /\0/, $link;
	$nodes{$from} = 1;
	$nodes{$to} = 1;
	$links{$link} = 1;
    }
    my $num_pathLinks = 0;
    foreach my $path (@paths_ordered) {
	my $last_node;
	my @nodes = split /\0/, $path;
	$num_pathLinks += $#nodes;
	foreach my $node (@nodes) {
	    $nodes{$node} = 1;
	    if (defined $last_node) {
		my $link = "$last_node\0$node";
		$links{$link} = 1;
	    }
	    $last_node = $node;
	}
    }

    if ($num_links > 0) {
	foreach my $id (0..$#nodes_ordered) {
	    $node2id{$nodes_ordered[$id]} = $id;
	}
    }
    if ($num_paths > 0)  {
	foreach my $id (0..$#links_ordered) {
	    $link2id{$links_ordered[$id]} = $id;
	}
    }

    return ($num_nodes, $num_links, $num_paths, $num_pathLinks);
}

sub GetNumPathLinks {
    my %links;

    foreach my $path (keys %path2value) {
	my $last_node;
	foreach my $node ( split /\0/, $path ) {
	}
    }
    my $num_pathLinks = keys %links;
    return $num_pathLinks;
}

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

sub print_links {
    print $filehandle "   \@links=" if defined ($verbose);
    print $filehandle "[\n";

    my $first_time = 1;
    foreach my $id (0..$#links_ordered) {
	my $link = $links_ordered[$id];
	my ($src, $dst) = split /\0/, $link;
	my $src_id = $node2id{$src};
	my $dst_id = $node2id{$dst};
	unless ($first_time == 1) {
	    print($filehandle ",\n"); 
	} 
	print $filehandle "      " if (defined $verbose);
	print $filehandle "{";
	print $filehandle " \@source=" if (defined $verbose);
	print $filehandle "$src_id;";
	print $filehandle " \@destination=" if (defined $verbose);
	print $filehandle "$dst_id;}";
	$first_time = 0;
    }

    print $filehandle "\n";
    print $filehandle "   " if (defined $verbose);
    print $filehandle "];\n";
}

sub print_paths {

    print $filehandle "   \@paths=" if (defined $verbose);
    print $filehandle "[\n";

    my $first_time = 1;
    foreach my $path_id (0..$#paths_ordered) {
	my $last_node;
	my @ids;
	foreach my $node (split /\0/, $paths_ordered[$path_id]) {
	    if (defined $last_node) {
		my $link = "$last_node\0$node";
		push @ids, $link2id{$link};
	    }
	    $last_node = $node;
	}
	unless ($first_time == 1) {
	    print($filehandle ",\n"); 
	} 
	print $filehandle "      " if (defined $verbose);
	print $filehandle "{ [ ", join(", ", @ids), "]; }";
	$first_time = 0;
    }

    print $filehandle "\n";
    print $filehandle "   " if (defined $verbose);
    print $filehandle "];\n";
}

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

sub print_attribute {
    my ($name, $type, $default) = @_;

    my $printer;
    if ($type eq "string") {
	$printer = sub {
	    my ($s) = @_;
	    $s =~ s/\\/\\\\/g;
	    $s =~ s/\"/\\\"/g;
	    return "\"$s\"";
	};
    } elsif ($type eq "int" || $type eq "double") {
	$printer = sub { my ($n) = @_; return sprintf("%d",$n); };
    } elsif ($type eq "float") {
	$printer = sub { my ($n) = @_; return $n."f"; };
    } elsif ($type eq "bool") {
	$printer = sub { 
	    my ($n) = @_; 
	    $n =~ y/A-Z/a-z/;
	    if ($n eq "true" || $n eq "t") {
		return "T";
	    } else {
		return "F";
	    }
	};
    } else {
	die("Unknown type: `$type'");
    }

    print $filehandle "      " if (defined $verbose);
    print $filehandle "{\n";
    print $filehandle "         \@name=" if (defined $verbose);
    print $filehandle "\$$name;\n";
    print $filehandle "         \@type=" if (defined $verbose);
    print $filehandle "$type;\n";
    print $filehandle "         \@default=" if (defined $verbose);
    if (defined $default) {
	print $filehandle $default;
    }
    print $filehandle ";\n";

    print $filehandle "         \@nodeValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%node2value, \@nodes_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "         \@linkValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%link2value, \@links_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "         \@pathValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%link2value, \@paths_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "      " if (defined $verbose);
    print $filehandle "}";

}

sub print_attributes_helper {
    my ($name, $objects, $objects_ordered, $printer) = @_;
    my $first_time = 1;
    my $num_effected_objects = 0;
    foreach my $id (0..$#$objects_ordered) {

	my $value = $objects->{$objects_ordered->[$id]}->{$name};
	if (defined $value) {
	    unless (1 == $first_time) {
		print $filehandle ",\n";
	    } else {
		print $filehandle "\n";
	    }
	    $first_time = 0;
	    my $format;
	    if (defined $verbose) {
		$format = "            { \@id=%d; \@value=%s; }";
	    } else {
		$format = "{%d;%s;}";
	    }
	    printf $filehandle $format, $id, &$printer($value);
	    $num_effected_objects++;
	}
    }
    print $filehandle "\n" if ($num_effected_objects > 0);
}

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

sub print_attribute_to_color  {
    my ($color_type, $name, $type) = @_;

    my $printer;
    if ($color_type eq "hot_to_cold") {
	if ($type eq "string") {
	    $printer = print_string_attribute_to_color_hot_to_cold_printer(
		$name, $type);
	    
	} elsif ($type eq "int" || $type eq "double" || $type eq "float") {
	    $printer = print_int_attribute_to_color_hot_to_cold_printer(
		$name, $type);

	} elsif ($type eq "bool") {
	    $printer = sub { 
		my ($n) = @_; 
		if ($n eq "T" || $n eq "t") {
		    return (200<<16) | (200<<8) | (200);
		} else {
		    return (100<<16) | (100<<8) | (100);
		}
	    };
	} else {
	    die("Unknown type: `$type'");
	}
    } else {
	die("Unknown color type: `$color_type' used for attribute "
	    ."`$name'");
    }

    print $filehandle "      " if (defined $verbose);
    print $filehandle "{\n";
    print $filehandle "         \@name=" if (defined $verbose);
    print $filehandle "\$color_by_$name;\n";
    print $filehandle "         \@type=" if (defined $verbose);
    print $filehandle "int;\n";
    print $filehandle "         \@default=" if (defined $verbose);
    print $filehandle ";\n";

    print $filehandle "         \@nodeValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%node2value, \@nodes_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "         \@linkValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%link2value, \@links_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "         \@pathValues=" if (defined $verbose);
    print $filehandle "[";
    print_attributes_helper($name, \%path2value, \@paths_ordered, $printer);
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";

    print $filehandle "      " if (defined $verbose);
    print $filehandle "}";
}

sub print_string_attribute_to_color_hot_to_cold_printer  {
    my ($name, $type) = @_;
    my %string2frequency;
    foreach my $node (@nodes_ordered) {
	if (defined $node2value{$node}{$name} ) {
	    $string2frequency{$node2value{$node}{$name}}++;
	}
    }
    foreach my $link (@links_ordered) {
	if (defined $link2value{$link}{$name} ) {
	    $string2frequency{$link2value{$link}{$name}}++;
	}
    }
    my @strings = sort {$string2frequency{$b} <=> $string2frequency{$a}}
	keys %string2frequency;
    my %string2color;

    my $i = 0;
    #while ($#strings > -1 && $i < $MAX_NUM_STR_COLORS) {
    while ($#strings > -1) {
	$string2color{shift @strings} = 
	    compute_integer_hot_to_cold($i++/($MAX_NUM_STR_COLORS+2));
    }
    my $printer = sub {
	my ($n) = @_;
	my $string2color = \%string2color;
	if (defined $string2color->{$n}) {
	    return $string2color->{$n};
	} else {
	    return compute_integer_hot_to_cold(
	    ($MAX_NUM_STR_COLORS+1)/($MAX_NUM_STR_COLORS+2));
	}
    };
    return $printer;
}

sub print_int_attribute_to_color_hot_to_cold_printer  {
    my ($name, $type) = @_;

    my ($min, $max);
    foreach my $object2value (\%node2value, \%link2value, \%path2value) {
	foreach my $object (keys %{$object2value}) {
	    my $v = $object2value->{$object}->{$name};
	    if (defined $v) {
		if (!defined $min) { 
		    $min = $max = $v;
		} elsif ($v < $min) {
		    $min = $v;
		} elsif ($v > $max) {
		    $max = $v;
		}
	    }
	}
    }

    my $printer = sub {
	my ($n) = @_;
	my $value;
	if ($max-$min == 0) {
	    $value = 1;
	} else {
	    $value = ($n-$min)/($max-$min);
	}
	return compute_integer_hot_to_cold($value);
    };
    return $printer;
}

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

sub print_qualifier {
    my ($type, $name, $attributes) = @_;

    unless (defined $type) {
	die("Graph:: Qualifier with out type");
    }
    unless (defined $name) {
	die("Graph:: Qualifier with out name");
    }
    print $filehandle "      " if (defined $verbose);
    print $filehandle "{\n";
    print $filehandle "         \@type=" if (defined $verbose);
    print $filehandle "\$$type;\n";
    print $filehandle "         \@name=" if (defined $verbose);
    print $filehandle "\$$name;\n";
    print $filehandle "         \@description=" if (defined $verbose);
    print $filehandle ";\n";
    print $filehandle "         \@attributes=" if (defined $verbose);
    print $filehandle "[\n";
    foreach my $i (0..$#$attributes) {
	my $attribute = $attributes->[$i];
	my $id = $attribute2id{$attribute};
	unless (defined $id) {
	    die("Graph::qualifier type:$type name:$name requires "
		." $attribute\n");
	} 
	my $format;
	if (defined $verbose) {
	    $format = "            { \@attribute=%s; \@alias=\$%s; }";
	} else {
	    $format = "{%s;\$%s;}";
	}
	printf $filehandle $format, $id, $attribute;
	if ($i < $#$attributes) {
	    print $filehandle ",\n";
	} else {
	    print $filehandle "\n";
	}
    }
    print $filehandle "         " if (defined $verbose);
    print $filehandle "];\n";
    print $filehandle "      " if (defined $verbose);
    print $filehandle "}";
}

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

# Code adapted from
# <http://www.swin.edu.au/astronomy/pbourke/colour/colourramp>,
# "Colour Ramping for Data Visualization", by Paul Bourke, July 1996.

sub compute_integer_hot_to_cold {
    my ($x) = @_;
    my $r = 255;
    my $g = 255;
    my $b = 255;

    if ($x < 0.0) {
	$x = 0.0;
    } elsif ($x > 1.0) {
	$x = 1.0;
    }

    if ($x < 0.25) {
	$r = 0;
	$g = int(255.0 * 4.0 * $x);
    } elsif ($x < 0.5) {
	$r = 0;
	$b = int(255.0 + 255.0 * 4.0 * (0.25 - $x));
    } elsif ($x < 0.75) {
	$r = int(255.0 * 4.0 * ($x - 0.5));
	$b = 0;
    } else {
	$g = int(255.0 + 255.0 * 4.0 * (0.75 - $x));
	$b = 0;
    }

    return ($r << 16) | ($g << 8) | $b;
}

1;