gifgraph.pm

mrtg 监控,请认真阅读您的文件包然后写出其具体功能

#==========================================================================
#              Copyright (c) 1995-1998 Martien Verbruggen
#--------------------------------------------------------------------------
#
#	Name:
#		GIFgraph.pm
#
#	Description:
#       Module to create graphs from a data set, outputting
#		GIF format graphics.
#
#		Package of a number of graph types:
#		GIFgraph::bars
#		GIFgraph::lines
#		GIFgraph::points
#		GIFgraph::linespoints
#		GIFgraph::area
#		GIFgraph::pie
#		GIFgraph::mixed
#
# $Id: GIFgraph.pm,v 1.1.1.1 2002/02/26 10:16:37 oetiker Exp $
#
#==========================================================================

require 5.004;

use strict;

use vars qw(@ISA);

# Use Lincoln Stein's GD and Thomas Boutell's libgd.a
use GD;

#
# GIFgraph
#
# Parent class containing data all graphs have in common.
#

package GIFgraph;

$GIFgraph::prog_name    = 'GIFgraph.pm';
$GIFgraph::prog_rcs_rev = '$Revision: 1.1.1.1 $';
$GIFgraph::prog_version = 
	($GIFgraph::prog_rcs_rev =~ /\s+(\d*\.\d*)/) ? $1 : "0.0";

$GIFgraph::VERSION = '1.10';

# Some tools and utils
use GIFgraph::colour qw(:colours);

my $OS;

# Let's guess what the OS is
# (from CGI.pm by Lincoln Stein)
# OVERRIDE THE OS HERE IF THE GUESS IS WRONG

# $OS = 'UNIX';
# $OS = 'MACINTOSH';
# $OS = 'WINDOWS';
# $OS = 'VMS';
# $OS = 'OS2';

# FIGURE OUT THE OS WE'RE RUNNING UNDER
# Some systems support the $^O variable.  If not
# available then require() the Config library
unless ($OS) {
    unless ($OS = $^O) {
        require Config;
        $OS = $Config::Config{'osname'};
    }
	if ($OS=~/Win/i) {
		$OS = 'WINDOWS';
	} elsif ($OS=~/vms/i) {
		$OS = 'VMS';
	} elsif ($OS=~/Mac/i) {
		$OS = 'MACINTOSH';
	} elsif ($OS=~/os2/i) {
		$OS = 'OS2';
	} else {
		$OS = 'UNIX';
	}
}

$GIFgraph::needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/;

my %GIFsize = ( 
	'x' => 400, 
	'y' => 300 
);

my %Defaults = (

	# Set the top, bottom, left and right margin for the GIF. These 
	# margins will be left empty.

	t_margin      => 0,
	b_margin      => 0,
	l_margin      => 0,
	r_margin      => 0,

	# Set the factor with which to resize the logo in the GIF (need to
	# automatically compute something nice for this, really), set the 
	# default logo file name, and set the logo position (UR, BR, UL, BL)

	logo_resize   => 1.0,
	logo          => undef,
	logo_position => 'LR',

	# Write a transparent GIF?

	transparent   => 1,

	# Write an interlaced GIF?

	interlaced    => 1,

	# Set the background colour, the default foreground colour (used 
	# for axes etc), the textcolour, the colour for labels, the colour 
	# for numbers on the axes, the colour for accents (extra lines, tick
	# marks, etc..)

	bgclr         => 'white',
	fgclr         => 'dblue',
	textclr       => 'dblue',
	labelclr      => 'dblue',
	axislabelclr  => 'dblue',
	accentclr     => 'gray',

	# number of pixels to use as text spacing

	text_space    => 8,
);

{
    #
    # PUBLIC methods, documented in pod.
    #
    sub new  # ( width, height ) optional;
	{
        my $type = shift;
        my $self = {};
        bless $self, $type;

        if (@_) 
		{
            # If there are any parameters, they should be the size
            $self->{gifx} = shift;

            # If there's an x size, there should also be a y size.
            die "Usage: GIFgraph::<type>::new( [x_size, y_size] )\n" unless @_;
            $self->{gify} = shift;
        } 
		else 
		{
            # There were obviously no parameters, so use defaults
            $self->{gifx} = $GIFsize{'x'};
            $self->{gify} = $GIFsize{'y'};
        }

        # Initialise all relevant parameters to defaults
        # These are defined in the subclasses. See there.
        $self->initialise( );

        return $self;
    }

    sub set
	{
        my $s = shift;
        my %args = @_;

        foreach (keys %args) 
		{ 
			$s->{$_} = $args{$_}; 
		}
    }

    # These should probably not be used, or be rewritten to 
    # accept some keywords. Problem is that GD is very limited 
    # on fonts, and this routine just accepts GD font names. 
    # But.. it's not nice to require the user to include GD.pm
    # just because she might want to change the font.

    sub set_title_font # (fontname)
	{
        my $self = shift;

        $self->{tf} = shift;
        $self->set( 
			tfw => $self->{tf}->width,
			tfh => $self->{tf}->height,
		);
    }

    sub set_text_clr # (colour name)
	{
        my $s = shift;
        my $c = shift;

        $s->set(
            textclr       => $c,
            labelclr      => $c,
            axislabelclr  => $c,
        );
    }

	sub plot # (\@data)
	{
		# ABSTRACT
		my $s = shift;
		$s->die_abstract( "sub plot missing," );
	}

    sub plot_to_gif # ("file.gif", \@data)
	{
        my $s = shift;
        my $file = shift;
        my $data = shift;

        open (GIFPLOT,">$file") || do 
		{ 
			warn "Cannot open $file for writing: $!";
			return 0; 
		};
		binmode GIFPLOT if ($GIFgraph::needs_binmode);
        print GIFPLOT $s->plot( $data );
        close(GIFPLOT);
    }

    # Routine to read GNU style data files
	# NOT USEABLE

    sub ReadFile 
	{
        my $file = shift; 
		my @cols = @_; 
		my (@out, $i, $j);

        @cols = 1 if ( $#cols < 1 );

        open (DATA, $file) || do { 
			warn "Cannot open file: $file"; 
			return []; 
		};

        $i=0; 
        while (defined(<DATA>)) 
		{ 
            s/^\s+|\s+$//;
            next if ( /^#/ || /^!/ || /^[ \t]*$/ );
            @_ = split(/[ \t]+/);
            $out[0][$i] = $_[0];
            $j=1;
            foreach (@cols) 
			{
                if ( $_ > $#_ ) { 
					warn "Data column $_ not present"; 
					return []; 
				}
                $out[$j][$i] = $_[$_]; $j++;
            }
            $i++;
        }
        close(DATA);

        return @out;

    } # ReadFile

    #
    # PRIVATE methods
    #

    # Set defaults that apply to all graph/chart types. 
    # This is called by the default initialise methods 
    # from the objects further down the tree.

    sub initialise()
	{
        my $self = shift;

		foreach (keys %Defaults) 
		{
			$self->set( $_ => $Defaults{$_} );
		}

        $self->set_title_font(GD::gdLargeFont);

		$self->open_graph();
    }


    # Check the integrity of the submitted data
    #
    # Checks are done to assure that every input array 
    # has the same number of data points, it sets the variables
    # that store the number of sets and the number of points
    # per set, and kills the process if there are no datapoints
    # in the sets, or if there are no data sets.

    sub check_data($) # \@data
	{
        my $self = shift;
        my $data = shift;

        $self->set(numsets => $#$data);
        $self->set(numpoints => $#{@$data[0]});

        ( $self->{numsets} < 1 || $self->{numpoints} < 0 ) && die "No Data";

		my $i;
        for $i ( 1..$self->{numsets} ) 
		{
			die "Data array $i: length misfit"
				unless ( $self->{numpoints} == $#{@$data[$i]} );
        }
    }

    # Open the graph output canvas by creating a new GD object.

    sub open_graph()
	{
        my $self = shift;
		if ( !exists $self->{graph} )
		{
			my $graph = new GD::Image($self->{gifx}, $self->{gify});
			$self->{graph} = $graph;
			return $graph;
		}
		else
		{
			return $self->{graph};
		}
    }

    # Initialise the graph output canvas, setting colours (and getting back
    # index numbers for them) setting the graph to transparent, and 
    # interlaced, putting a logo (if defined) on there.

    sub init_graph($) # GD::Image
	{
        my $self = shift;
        my $graph = shift;

        $self->{bgci} = $self->set_clr( $graph, _rgb($self->{bgclr}) );
        $self->{fgci} = $self->set_clr( $graph, _rgb($self->{fgclr}) );
        $self->{tci}  = $self->set_clr( $graph, _rgb($self->{textclr}) );
        $self->{lci}  = $self->set_clr( $graph, _rgb($self->{labelclr}) );
        $self->{alci} = $self->set_clr( $graph, _rgb($self->{axislabelclr}) );
        $self->{acci} = $self->set_clr( $graph, _rgb($self->{accentclr}) );
        $graph->transparent($self->{bgci}) if $self->{transparent};
        $graph->interlaced($self->{interlaced});
        $self->put_logo($graph);
    }

    # read in the logo, and paste it on the graph canvas

    sub put_logo($) # GD::Image
	{
        my $self = shift;
        my $graph = shift;

		return unless(defined($self->{logo}));

        my ($x, $y, $glogo);
        my $r = $self->{logo_resize};

        my $r_margin = (defined $self->{r_margin_abs}) ? 
            $self->{r_margin_abs} : $self->{r_margin};
        my $b_margin = (defined $self->{b_margin_abs}) ? 
            $self->{b_margin_abs} : $self->{b_margin};

        open(GIFLOGO, $self->{logo}) || return;
		binmode(GIFLOGO) if ($GIFgraph::needs_binmode);
        unless ( $glogo = newFromGif GD::Image(\*GIFLOGO) ) 
		{
            warn "Problems reading $self->{logo}"; 
			close(GIFLOGO); 
			return;
        }
        close(GIFLOGO);

        my ($w, $h) = $glogo->getBounds;
        LOGO: for ($self->{logo_position}) {
            /UL/i && do {
                $x = $self->{l_margin};
                $y = $self->{t_margin};
                last LOGO;
            };
            /UR/i && do {
                $x = $self->{gifx} - $r_margin - $w * $r;
                $y = $self->{t_margin};
                last LOGO;
            };
            /LL/i && do {
                $x = $self->{l_margin};
                $y = $self->{gify} - $b_margin - $h * $r;
                last LOGO;
            };
            # default "LR"
            $x = $self->{gifx} - $r_margin - $r * $w;
            $y = $self->{gify} - $b_margin - $r * $h;
            last LOGO;
        }
        $graph->copyResized($glogo, $x, $y, 0, 0, $r * $w, $r * $h, $w, $h);
        undef $glogo;
    }

    # Set a colour to work with on the canvas, by rgb value. 
    # Return the colour index in the palette

    sub set_clr($$$$) # GD::Image, r, g, b
	{
        my $s = shift; 
		my $g = shift; 
		my $i;

        # Check if this colour already exists on the canvas
        if ( ( $i = $g->colorExact( @_ ) ) < 0 ) 
		{
            # if not, allocate a new one, and return it's index
            return $g->colorAllocate( @_ );
        } 
        return $i;
    }
    
    # Set a colour, disregarding wether or not it already exists.

    sub set_clr_uniq($$$$) # GD::Image, r, g, b
	{
        my $s=shift; 
        my $g=shift; 

        $g->colorAllocate( @_ ); 
    }

    # Return an array of rgb values for a colour number

    sub pick_data_clr($) # number
	{
        my $s = shift;

		# Set up the data colour list if it doesn't exist yet.
		# It seemed easier & more robust to me to do it here rather than
		# relying on users doing it.	AF
		$s->set( 
			dclrs => [ qw(lred lgreen lblue lyellow lpurple lbrown cyan
				lorange marine dyellow red green yellow blue
				lgray dbrown purple orange pink gold)] 
		) unless ( exists $s->{dclrs} );

        return _rgb( $s->{dclrs}[ $_[0] % (1+$#{$s->{dclrs}}) -1 ] );
    }

    # DEBUGGING
	# data_dump obsolete now, use Data::Dumper

	sub die_abstract()
	{
		my $s = shift;
		my $msg = shift;
		# ABSTRACT
		die
			"Subclass (" .
			ref($s) . 
			") not implemented correctly: " .
			(defined($msg) ? $msg : "unknown error");
	}

    # Return the gif contents

    sub gifdata() 
	{
        my $s = shift;

        return $s->{graph}->gif;
    }

} # End of package GIFgraph

$GIFgraph::prog_name;

__END__

=head1 NAME

GIFgraph - Graph Plotting Module for Perl 5

=head1 SYNOPSIS

use GIFgraph::moduleName;

=head1 DESCRIPTION

B<GIFgraph> is a I<perl5> module to create and display GIF output 
for a graph.
The following classes for graphs with axes are defined:

=over 4

=item C<GIFgraph::lines>

Create a line chart.

=item C<GIFgraph::bars>

Create a bar chart.

=item C<GIFgraph::points>

Create an chart, displaying the data as points.

=item C<GIFgraph::linespoints>

Combination of lines and points.

=item C<GIFgraph::area>

Create a graph, representing the data as areas under a line.

=item C<GIFgraph::mixed>

Create a mixed type graph, any combination of the above. At the moment
this is fairly limited. Some of the options that can be used with some
of the individual graph types won't work very well. Multiple bar
graphs in a mixed graph won't display very nicely.

=back

Additional types:

=over 4

=item C<GIFgraph::pie>

Create a pie chart.

=back

=head1 EXAMPLES

See the samples directory in the distribution.

=head1 USAGE

Fill an array of arrays with the x values and the values of the data
sets.  Make sure that every array is the same size, otherwise
I<GIFgraph> will complain and refuse to compile the graph.

    @data = ( 
        ["1st","2nd","3rd","4th","5th","6th","7th", "8th", "9th"],
        [    1,    2,    5,    6,    3,  1.5,    1,     3,     4]
        [ sort { $a <=> $b } (1, 2, 5, 6, 3, 1.5, 1, 3, 4) ]
    );

If you don't have a value for a point in a certain dataset, you can
use B<undef>, and I<GIFgraph> will skip that point.