File Coverage

blib/lib/Text/BarGraph.pm

Criterion	Covered	Total	%
statement	12	118	10.1
branch	0	56	0.0
condition	0	20	0.0
subroutine	4	12	33.3
pod	2	2	100.0
total	18	208	8.6

package Text::BarGraph;

use strict;
use warnings;

use vars qw /$AUTOLOAD $VERSION/;

use Carp;

=head1 NAME

Text::BarGraph - Text Bar graph generator

=head1 SYNOPSIS

  use Text::BarGraph;

  $graph = Text::BarGraph->new();

=head1 ABSTRACT

A module to create text bar graphs

=head1 DESCRIPTION

This module takes as input a hash, where the keys are labels for bars on
a graph and the values are the magnitudes of those bars.

=head1 EXAMPLE

  $graph = Text::BarGraph->new();

  %hash = (
    alpha => 30,
    beta  => 40,
    gamma => 25
  );

  print $g->graph(\%hash);

=head1 METHODS

=over 4

=cut

our $VERSION = 1.1;
our %fields = (
	dot		=> '#',		# character to graph with
	num		=> 1,		# display data value in ()'s
	enable_color	=> 0,		# whether or not to color the graph
	sortvalue	=> "key",	# key or data
	sorttype	=> "string",	# string or numeric, ignored if sort is 'data'
	zero		=> 0,		# value to start the graph with
	max_data	=> 0,		# where to end the graph
	autozero	=> 0,		# automatically set start value
	autosize	=> 1,		# requires Term::ReadKey
	columns		=> 80,		# columns
);

=item I

  $graph = Text::BarGraph->new();

The constructor.

=cut
sub new {
	my $that = shift;
	my $class = ref($that) || $that;

	my $self = {
		_permitted => \%fields,
		%fields,
	};

	my %args = @_;

	while(my ($field, $value) = each %args) {
		if(exists($self->{'_permitted'}{$field})) {
			$self->{$field} = $value;
		} else {
			croak "Invalid field name '$field' in class $class";
		}
	}

	if(eval "require Term::ANSIColor") {
		import Term::ANSIColor;
		$self->{'colortype'} = "module";
	} else {
		$self->{'colortype'} = "raw";
	}

	bless $self, $class;
	return $self;
}

sub DESTROY { }

sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self) || die "$self is not an object";
	my $name = $AUTOLOAD;
	$name =~ s/.*://; # strip fully qualified portion
	unless (exists $self->{'_permitted'}{$name} ) {
		croak "Invalid field name '$name' in class $type";
	}

	if (@_) {
		$self->{$name} = shift;
	}
	return $self->{$name};
}

=item I

  $graph_text = $graph->graph(\%data);

Return a graph of the data in the supplied hash. The keys in
the hash are labels, and the values are the magnitudes.

=cut
sub graph {
	my ($self, $data) = @_;
	my $gtext = '';
	my $label_length = 5;
	my $scale = 1;
	my $sep = " ";
	my $barsize = 0;
	my $sort_sub;
 	my $min_data;
	my $max_data;

	my $columns = $self->{'columns'};

	# silently fail to autoresize if we are not talking to a tty
	# OR if the Term::ReadKey module doesn't exist
	if($self->{'autosize'} && -t STDOUT && eval "require Term::ReadKey") {
		import Term::ReadKey;
		($columns) = GetTerminalSize('STDOUT');
	}

	# find initial column width and scaling
	foreach my $key (keys %{$data}) {
		if(!defined($min_data) || $min_data > $data->{$key}) {
			$min_data = $data->{$key};
		}
		if(length($key) > $label_length) {
			$label_length = length($key);
		}
		if(!defined($max_data) || $data->{$key} > $max_data) {
			$max_data = $data->{$key};
		}
	}
	if(!defined($max_data) || $self->{'max_data'} > $max_data) {
		$max_data = $self->{'max_data'};
	}

	# determine how many columns are left for the graph after
	# the labels
	my $data_length = length($max_data);
	if($label_length > ($columns * .25)) {
		$sep = "\n";
		$barsize = $columns;
	} else {
		$sep = " ";
		if($self->{'num'}) {
			$barsize = $columns - ($label_length + $data_length + 4);
		} else {
			$barsize = $columns - ($label_length + 1);
		}
	}

	if($self->{'autozero'}) {
		$self->{'zero'} = int($min_data - (($max_data - $min_data) / ($barsize - 1)));
	}

	# determine points to change colors
	my ($p1, $p2, $p3) = 0;
	if($self->{'enable_color'}) {
		$p1 = int($barsize * .25);
		$p2 = $p1*2; $p3 = $p1*3;
	}

	if($max_data) { $scale = $barsize / ($max_data - $self->{'zero'}); }

	# create a sort subroutine based on sortvalue and sorttype
	if($self->{'sortvalue'} eq "key") {
		if($self->{'sorttype'} eq "string") {
			$sort_sub = sub { return $a cmp $b; }
		} else {
			$sort_sub = sub { return $a <=> $b; }
		}
	} else {
		$sort_sub = sub { return $data->{$a} <=> $data->{$b}; }
	}

	# build the graph
	foreach my $label (sort $sort_sub keys %{$data}) {
		my $bar = '';
		my $dots = int(($data->{$label} - $self->{'zero'}) * $scale);

		if($self->{'enable_color'}) {
			$bar = $self->_colordots($p1, $p2, $p3, $dots);
		} else {
			$bar = $self->{'dot'}x$dots;
		}

		if($self->{'num'}) {
			$gtext .= sprintf "%${label_length}s (%${data_length}d)${sep}%s\n",
				$label, $data->{$label}, $bar;
		} else {
			$gtext .= sprintf "%${label_length}s${sep}%s\n", $label, $bar;
		}
	}

	# add a line giving the start point if it's not zero
	if($self->{'zero'}) {
		if($self->{'num'}) {
			$gtext .= sprintf "%${label_length}s  %${data_length}d /\n", '', $self->{'zero'};
		} else {
			$gtext .= sprintf "%${label_length}s /\n", "$self->{'zero'}";
		}
	}
	return $gtext;
}

sub _colordots {
	my ($self, $p1, $p2, $p3, $dots) = @_;

	my $bar = '';

	if($self->{'colortype'} eq "module") {
		$bar = color('blue');

		for(1..$dots) {
			if(   $_ eq $p1) { $bar .= color('green'); }
			elsif($_ eq $p2) { $bar .= color('yellow'); }
			elsif($_ eq $p3) { $bar .= color('red'); }

			$bar .= $self->{'dot'};
		}
		$bar .= color('reset');

	} elsif($self->{'colortype'} eq "raw") {
		$bar = "\e[34m"; # start blue

		for(1..$dots) {
			if(   $_ eq $p1) { $bar .= "\e[32m"; } # green
			elsif($_ eq $p2) { $bar .= "\e[33m"; } # yellow
			elsif($_ eq $p3) { $bar .= "\e[31m"; } # red
			$bar .= $self->{'dot'};
		}
		$bar .= "\e[0m"; # turn the color off
	}
	return $bar;
}

1;

__DATA__