package Yaala::Report::GDGraph;

use strict;
use warnings;
use vars qw#$GRAPH_WIDTH $GRAPH_HEIGHT#;

use Exporter;
use Yaala::Data::Core qw#get_values receive#;
use Yaala::Config qw#get_config#;
use Yaala::Html qw#get_filename get_title#;
use Yaala::Report::Core qw#$OUTPUTDIR#;

@Yaala::Report::GDGraph::EXPORT_OK = qw#generate_graph $GRAPH_WIDTH $GRAPH_HEIGHT#;
@Yaala::Report::GDGraph::ISA = ('Exporter');

$GRAPH_WIDTH = 500;
$GRAPH_HEIGHT = 250;

our $HAVE_GD_GRAPH = 0;
our $MAX_VALUES = 25;
our $WANT_GRAPHS = 0;

my $VERSION = '$Id: GDGraph.pm,v 1.9 2003/12/07 14:53:30 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

eval "use GD::Graph::bars;";
if (!$@)
{
	$HAVE_GD_GRAPH = 1;
	print STDERR ' - GD::Graph is installed' if ($::DEBUG);
}
else
{
	print STDERR ' - GD::Graph is NOT installed' if ($::DEBUG);
}

$WANT_GRAPHS = $HAVE_GD_GRAPH;

if (get_config ('graph_height'))
{
	my $height = get_config ('graph_height');
	$height =~ s/\D//g;

	if (($height > 100) and ($height < 1000))
	{
		$GRAPH_HEIGHT = $height;
	}
	else
	{
		print STDERR $/, __FILE__, ": ``$height'' is not a valid value for ``graph_height'' and will be ignored.";
	}
}

if (get_config ('graph_width'))
{
	my $width = get_config ('graph_width');
	$width =~ s/\D//g;

	if (($width > 100) and ($width < 1000))
	{
		$GRAPH_WIDTH = $width;
		$MAX_VALUES = int ($GRAPH_WIDTH / 20);
	}
	else
	{
		print STDERR $/, __FILE__, ": ``$width'' is not a valid value for ``graph_width'' and will be ignored.";
	}
}

if (get_config ('print_graphs'))
{
	my $want = lc (get_config ('print_graphs'));
	if ($want eq 'no' or $want eq 'false' or $want eq 'off')
	{
		$WANT_GRAPHS = 0;
	}
	elsif ($want eq 'yes' or $want eq 'true' or $want eq 'on')
	{
		if (!$HAVE_GD_GRAPH)
		{
			print STDERR $/, __FILE__, ": You've set ``print_graphs'' to ``$want''.",
				$/, __FILE__, '  However, the graphs cannot be genereted, because GD::Graph cannot be found.',
				$/, __FILE__, '  Please go to your nearest CPAN-mirror and install it first.',
				$/, __FILE__, '  This config-option will be ignored.';
		}
	}
	elsif ($want eq 'auto' or $want eq 'automatic')
	{
		# do nothing.. Already been done.
	}
	else
	{
		print STDERR $/, __FILE__, ": You've set ``print_graphs'' to ``$want''.",
			$/, __FILE__, '  This value is not understood and is being ignored.';
	}
}

if ($::DEBUG & 0x100)
{
	print STDERR $/, __FILE__, ': Size: ', $GRAPH_WIDTH, 'x', $GRAPH_HEIGHT,
	"; Max number of values: $MAX_VALUES";
}

return (1);

sub generate_graph
{
	my $sel = shift;
	my $key = shift;

	my $where_key = shift;
	my $where_val = shift;

	return ('') unless ($HAVE_GD_GRAPH and $WANT_GRAPHS);

	if (!defined ($where_key) or !defined ($where_val)
			or !$where_key or !$where_val)
	{
		$where_key = '';
		$where_val = '';
	}

	my @aggs = @{$sel->[0]};
	my $num_aggs = scalar (@aggs);
	
	my $filename = get_filename ($sel);
	{
		my $replacement = "__$key";
		if ($where_key)
		{
			$replacement .= "__$where_key" . "_$where_val";
		}
		$replacement =~ s/\W+/_/g;
		$replacement .= '.png';

		$filename =~ s/\.html$/$replacement/;
	}
	
	my @key_values = get_values ($sel, $key);
	@key_values = sort (@key_values);

	my @agg_values = get_agg_values ($sel, $key, \@key_values, $where_key, $where_val);

	if (scalar (@key_values) > $MAX_VALUES)
	{
		discard_values (\@key_values, \@agg_values);
	}

	for (@key_values)
	{
		next if (length ($_) < 20);

		substr ($_, 17) = ' ..';
	}

	my @data_set = (\@key_values, @agg_values);

	my $title = join (', ', map { ucfirst ($_) } (@aggs)) . ' by ' . ucfirst ($key);
	if ($where_val) { $title .= ' for ' . $where_val; }
	
	print STDERR $/, __FILE__, qq#: Generating image "$title" [$filename]#
	if ($::DEBUG & 0x100);
	
	my $graph = GD::Graph::bars->new ($GRAPH_WIDTH, $GRAPH_HEIGHT);
	$graph->set
	(
		title		=> $title,
		x_label		=> ucfirst ($key),
		y_label		=> 'Percent',
		
		x_labels_vertical => 1,
		x_label_position  => 1,
		long_ticks	=> 1,
		
#		logo		=> 'reports/logo.png',
		transparent	=> 1,
		shadow_depth	=> 2,

		fgclr		=> 'lgray',
		bgclr		=> 'white',
		dclrs		=> [ qw(lgray gray dgray) ],
		borderclrs	=> [ qw(black black black) ],
		shadowclr	=> 'gray',
		labelclr	=> 'black',
		axislabelclr	=> 'black',
		legendclr	=> 'black',
		valuesclr	=> 'black',
		textclr		=> 'black'
	);

	if ($num_aggs > 1)
	{
		$graph->set (legend_placement => 'BR');
		$graph->set_legend (map { ucfirst ($_) } (@aggs));
	}
	
	if (open (IMG, ">  $OUTPUTDIR$filename"))
	{
		binmode IMG;
		print IMG $graph->plot(\@data_set)->png;
		close IMG;
	}
	else
	{
		print STDERR $/, __FILE__, ": Unable to open ``$filename'': $!";
		$filename = undef;
	}

	return ($filename);
}

sub discard_values
{
	my $key_array = shift;
	my $val_array = shift;

	my @orig_sort = @$key_array;
	my $num_values = scalar (@$key_array);

	return (1) if ($num_values < $MAX_VALUES);

	my %vals_by_key = ();
	my %tmp_hash = ();

	my $i;
	for ($i = 0; $i < $num_values; $i++)
	{
		my $key = shift (@$key_array);
		my @vals = ();
		my $sum = 0;

		for (@$val_array)
		{
			my $tmp = shift (@$_);
			push (@vals, $tmp);
			$sum += $tmp;
		}

		$vals_by_key{$key} = \@vals;
		$tmp_hash{$key} = $sum;
	}
	
	my @small_sorted = sort { $tmp_hash{$b} <=> $tmp_hash{$a} } (keys (%tmp_hash));

	for ($i = 0; $i < $MAX_VALUES; $i++)
	{
		shift (@small_sorted);
	}
	
	for (@orig_sort)
	{
		my $this_key = $_;
		if (grep { $_ eq $this_key } (@small_sorted))
		{
			#$other += $tmp_hash{$this_key};
		}
		else
		{
			push (@$key_array, $this_key);
			my $vals = $vals_by_key{$this_key};
			for (@$val_array)
			{
				my $val = shift (@$vals);
				push (@$_, $val);
			}
		}
	}
}

sub get_agg_values
{
	my $sel = shift;
	my $key = shift;
	my $key_values = shift;

	my $where_key = '';
	my $where_val = '';

	if (@_)
	{
		$where_key = shift;
		$where_val = shift;
	}
	
	my @aggs = @{$sel->[0]};
	my @agg_values = ();
	
	my %max_val = ();
	
	for (@aggs)
	{
		my $agg = $_;
		my @tmp = ();
		$max_val{$agg} = 0;
		
		my $grand_total = 0;
		#if (scalar (@aggs) > 1)
		{
			my %query = ();
			if ($where_key) { $query{$where_key} = $where_val; }
			
			$grand_total = receive ($sel, $agg, {});
		}
		
		for (@$key_values)
		{
			my %query = ($key => $_);
			if ($where_key) { $query{$where_key} = $where_val; }
	
			my $sum = receive ($sel, $agg, \%query);

			if ($grand_total)
			{
				$sum = 100 * $sum / $grand_total;
			}

			push (@tmp, $sum);

			if ($sum > $max_val{$agg})
			{
				$max_val{$agg} = $sum;
			}
		}

		push (@agg_values, \@tmp);
	}

	return (@agg_values);
}
