#!/usr/bin/perl -w
#
# This is an example of a subclass of the generated application
#
# You can safely edit this file, any changes that you make will be preserved
# and this file will not be overwritten by the next run of Glade::PerlGenerate
#
#==============================================================================
#=== This is the 'Submain_window' class                              
#==============================================================================
package Submain_window;
require 5.000; use strict 'vars', 'refs', 'subs';

use XML::Simple;
# Needs to be defined, or XML::Simple will pick up XML::SAX as the default
# parser (extremely slow compared to expat-based XML::Parser)
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';

use FileHandle;
use GD::Graph::area;
use GD::Graph::lines;
use GD::Graph::colour ":files";
use File::MkTemp;
use POSIX;

my $cricket_config = "/s/cricket/common/cricket-config";
my $cricket_data = "/s/cricket/common/cricket-data";
my $rrdtool = "/s/rrdtool/bin/rrdtool";

# UI class 'Submain_window' (version 0.01)
# 
# Copyright (c) Date Thu Aug  7 09:37:39 CDT 2003
# Author Nathan Mueller <nmueller\@newton.cs.wisc.edu>
#
## Unspecified copying policy, please contact the author\n#  Nathan Mueller <nmueller\@newton.cs.wisc.edu>
#
#==============================================================================
# This perl source file was automatically generated by 
# Glade::PerlGenerate version 0.59 - Wed Jun 20 14:48:25 BST 2001
# Copyright (c) Author Dermot Musgrove <dermot.musgrove\@virgin.net>
#
# from Glade file /afs/cs.wisc.edu/u/n/m/nmueller/work/cricket_regraph/cricket_regraph.glade
# Thu Aug  7 09:37:39 CDT 2003
#==============================================================================

BEGIN {
    use vars qw( 
                 @ISA
                 %fields
                 $PACKAGE
                 $VERSION
                 $AUTHOR
                 $DATE
                 $permitted_fields
             );
    # Existing signal handler modules
    use src::Cricket_regraph;
    # We need the Gnome bindings as well
    use Gnome;
    # Uncomment the line below to enable gettext checking
#    use Glade::PerlSource;
    # Tell interpreter who we are inheriting from
    @ISA     = qw( main_window );
    # Uncomment the line below to enable gettext checking
#    @ISA      = qw( main_window Glade::PerlSource );
    $PACKAGE = 'SubCricket_regraph';
    $VERSION = '0.01';
    $AUTHOR  = 'Nathan Mueller <nmueller\@newton.cs.wisc.edu>';
    $DATE    = 'Thu Aug  7 09:37:39 CDT 2003';
    $permitted_fields = '_permitted_fields';             
    # Inherit the AUTOLOAD dynamic methods from main_window
    *AUTOLOAD = \&main_window::AUTOLOAD;
} # End of sub BEGIN

%fields = (
# Insert any extra data access methods that you want to add to 
#   our inherited super-constructor (or overload)
    USERDATA    => undef,
    VERSION     => '0.01',
);

sub DESTROY {
    # This sub will be called on object destruction
} # End of sub DESTROY

#==============================================================================
#=== Below are the overloaded class constructors
#==============================================================================
sub new {
    my $that  = shift;
    # Allow indirect constructor so that we can call eg. 
    #   $window1 = BusFrame->new; $window2 = $window1->new;
    my $class = ref($that) || $that;

    # Call our super-class constructor to get an object and reconsecrate it
    my $self = bless $that->SUPER::new(), $class;

    # Add our own data access methods to the inherited constructor
    my($element);
    foreach $element (keys %fields) {
        $self->{$permitted_fields}->{$element} = $fields{$element};
    }
    @{$self}{keys %fields} = values %fields;
    return $self;
} # End of sub new

sub app_run {
    my ($class, $config) = @_;
    Gnome->init('Cricket_regraph', '0.01');
    # Uncomment the line below to enable gettext checking
#    $class->check_gettext_strings;
    my $window = $class->new;
    # Insert your subclass user data key/value pairs 
    $window->USERDATA({
#        'Key1'   => 'Value1',
#        'Key2'   => 'Value2',
#        'Key3'   => 'Value3',
    });
    $window->TOPLEVEL->show;
#    my $window2 = $window->new;
#    $window2->TOPLEVEL->show;

    # Parse the config files
    die "Can't find config file $config"
	unless -e $config;
    $window->{FORM}{config} = &read_config($config);

    # Get the right colors
    &GD::Graph::colour::read_rgb("/usr/share/X11/rgb.txt");

    # Make the label big
    my $style = new Gtk::RcStyle;
    $style->modify_font("-*-arial-bold-r-normal-*-48-*-*-*-*-*-*-*");
    $window->{FORM}{label}->modify_style($style);
    
    # Setup the timeout
    Gtk->timeout_add(15000, \&display_graph, $window->{FORM});
    
    # Display the first graph
    &display_graph($window->{FORM});

    Gtk->main;
    # Uncomment the line below to enable gettext checking
#    $window->write_gettext_strings("__", '/afs/cs.wisc.edu/u/n/m/nmueller/work/cricket_regraph/src/Cricket_regraph.pot');
    $window->TOPLEVEL->destroy;

    return $window;
} # End of sub run
#===============================================================================
#=== Below are (overloaded) default signal handlers for 'main_window' class 
#===============================================================================
sub about_Form {
    my ($class) = @_;
    my $gtkversion = 
        Gtk->major_version.".".
        Gtk->minor_version.".".
        Gtk->micro_version;
    my $name = $0;
    #
    # Create a Gnome::About '$ab'
    my $ab = new Gnome::About(
        $PACKAGE, 
        $VERSION, 
        _("Copyright")." $DATE", 
        $AUTHOR, 
        _("No description")."\n".
        "Gtk ".     _("version").": $gtkversion\n".
        "Gtk-Perl "._("version").": $Gtk::VERSION\n".
        `gnome-config --version`."\n".
        _("run from file").": $name\n".
        "# Unspecified copying policy, please contact the author\n# ", 
        "$Glade::PerlRun::pixmaps_directory/glade2perl_logo.xpm", 
    );
    $ab->set_title(_("About")." SubCricket_regraph" );
    $ab->position('mouse' );
    $ab->set_policy(1, 1, 0 );
    $ab->set_modal(1 );
    $ab->show;
} # End of sub about_Form

sub destroy_Form {
    my ($class, $data, $object, $instance) = @_;
    Gtk->main_quit; 
} # End of sub destroy_Form

sub toplevel_hide    { shift->get_toplevel->hide    }
sub toplevel_close   { shift->get_toplevel->close   }
sub toplevel_destroy { shift->get_toplevel->destroy }

#==============================================================================
#=== Below are (overloaded) signal handlers for 'main_window' class 
#==============================================================================

sub display_graph
{
    my ($form) = @_;

    # Get a graph and rotate
    my $graph = pop @{$form->{config}};
    unshift @{$form->{config}}, $graph;

    # Generate the .png
    my $file = mktemp("graphXXXXXX", "/tmp");
    $file = "/tmp/$file";
    &gen_image($graph, $file);

    # Load the image
    $form->{pixmap}->load_file($file);
    unlink $file;
    
    # Set the label
    $form->{label}->set_text(ucfirst($graph->{target}) . ": $graph->{name}");

    1;
}   

sub gen_image
{
    my ($graph, $file) = @_;

    my $data = XMLin(new FileHandle "$rrdtool dump $cricket_data/$graph->{path}/$graph->{target}.rrd|");
    my @recent = @{$data->{rra}[0]{database}{row}};

    # Graph type
    my $config = $graph->{graphs}{$graph->{view}[0]};
    my $type = $config->{'draw-as'};
    if ($type eq "STACK" || $type eq "AREA")
    {
	$type = "area";
    }
    else
    {
	$type = "lines";
    }

    my @data;
    my @time;
    my $max;
    my @view = @{$graph->{view}};
    foreach (map { $_->{v} } @recent)
    {
	my @point;
	my $i;
	my $total;
	foreach my $ds (@view)
	{
	    my $index = $graph->{ds}{$ds};
	    my $data = $_->[$index];
	    $data = 0 if $data eq " NaN ";
	    push @{$data[$i++]}, $data+$total;
	    $max = $data+$total if $data+$total > $max;
	    $total += $data if $type eq "area";
	}
	my $time = strftime("%H:%M", localtime(time - @time*300));
	$time =~ s/:0[1-4]/:00/;
	if ($time =~ /(\d\d):00/ && !($1 % 6))
	{
	    unshift @time, $time;
	}
	else
	{
	    unshift @time, "";
	}
    }

    @data = reverse @data
	if $type eq "area";

    my $pic = eval("GD::Graph::${type}->new(1280, 950)");
    $pic->set(y_label => $config->{'y-axis'},
	      y_number_format => '%d',
	      y_max_value => $max*1.05,
	      x_ticks => 0,
	      bgclr => 'light gray',
	      fgclr => 'black',
	      textclr => 'black',
	      labelclr => 'black',
	      axislabelclr => 'black',
	      transparent => 0,
	      legend_placement => 'B'
	      );
    $pic->set(line_width => 2)
	if $type eq "lines";
    if ($type eq "area")
    {
	$pic->set(dclrs => [reverse map { $graph->{graphs}{$_}{color} } @{$graph->{view}}]);
    }
    else
    {
	$pic->set(dclrs => [map { $graph->{graphs}{$_}{color} } @{$graph->{view}}]);
    }
    $pic->set_legend(map { $graph->{graphs}{$_}{legend} } @{$graph->{view}})
	if $type eq "lines";
    $pic->set_legend(reverse map { $graph->{graphs}{$_}{legend} } @{$graph->{view}})
	if $type eq "area";
    my $gd = $pic->plot([\@time, @data]);

    my $out = new FileHandle ">$file";
    print $out $gd->png;
    $out->close;
}

sub read_config
{
    my ($file) = @_;

    my $fh = new FileHandle $file;
    chomp(my @lines = <$fh>);
    $fh->close;

    my @graphs;
    foreach my $line (@lines)
    {
	$line =~ s/\s+//g;
	next unless $line;

	push @graphs, &parse_config($line);
    }

    return \@graphs;
}

sub parse_config
{
    my ($line) = @_;
    
    my ($path, $target, $view) = $line =~ /(.*)\/(.*):(.*)/;

    my $i;
    my %views;
    my %graphs;
    my %data_sources;
    my $defaults = "$cricket_config/$path/Defaults";
    while (! -e $defaults)
    {
	$defaults =~ s/\/[^\/]+\/Defaults/\/Defaults/;
	die "Can't find Defaults file" if $defaults eq "/Defaults";
    }
    my $config = new FileHandle $defaults;
    while (chomp(my $line = <$config>))
    {
	if ($line =~ /^datasource\s+([^-\s]\S+)/)
	{
	    $data_sources{$1} = $i++;
	}
	elsif ($line =~ /graph\s+([^-]\S+)/)
	{
	    my $name = $1;
	    my %graph;
	    while (1)
	    {
		chomp($line = <$config>);
	     
		my $key;
		my $val;
		if ($line =~ /\"/)
		{
		    ($key, $val) = $line =~ /(\S+)\s*=\s*\"([^\"]+)\"/
		}
		else
		{
		    ($key, $val) = $line =~ /(\S+)\s*=\s*(\S+)/;
		}

		last unless $key;

		$graph{$key} = $val;
	    }
	    $graph{color} =~ s/(.).+-/\1/;
	    $graphs{$name} = \%graph;
	}
	elsif ($line =~ /^targetType/)
	{
	    my @ds;
	    while (1)
	    {
		chomp($line = <$config>);
		while ($line !~ /\"\s*$/)
		{
		    chomp(my $next = <$config>);
		    $line .= "\n$next";
		}
		$line =~ s/\n/ /gm;
		last unless $line =~ /(\S+)\s*=\s*\"(.*)\"/;
		my ($key, $val) = ($1, $2);
		if ($key eq "ds")
		{
		    @ds = split(/,\s+/, $val);
		}
		elsif ($line =~ /\S/)
		{
		    my $i = 0;
		    my @parts = split(/,\s+/, $val);
		    foreach (@parts)
		    {
			s/(\S+):\s+//;
			my $name = $1;
			my @dses = split(/\s+/, $_);
			
			$views{$name} = \@dses;
		    }
		    last;
		}
	    }
	}
    }
    
    die "Can't find $path:$view\n"
	unless $views{$view};

    die "Can't find $path/$target\n"
	unless -e "$cricket_data/$path/$target.rrd";

    return { path => $path, 
	     target => $target,
	     view => $views{$view},
	     name => $view,
	     graphs => \%graphs,
	     ds => \%data_sources };
}






1;

__END__

#===============================================================================
#==== Documentation
#===============================================================================
=pod

=head1 NAME

SubCricket_regraph - version 0.01 Thu Aug  7 09:37:39 CDT 2003

No description

=head1 SYNOPSIS

 use SubCricket_regraph;

 To construct the window object and show it call
 
 Gtk->init;
 my $window = Submain_window->new;
 $window->TOPLEVEL->show;
 Gtk->main;
 
 OR use the shorthand for the above calls
 
 Submain_window->app_run;

=head1 DESCRIPTION

Unfortunately, the author has not yet written any documentation :-(

=head1 AUTHOR

Nathan Mueller <nmueller\@newton.cs.wisc.edu>

=cut
