File Coverage

lib/Text/HistogramChart.pm

Criterion	Covered	Total	%
statement	145	158	91.7
branch	72	110	65.4
condition	13	27	48.1
subroutine	11	11	100.0
pod	3	3	100.0
total	244	309	78.9

package Text::HistogramChart;

## no critic (Subroutines::RequireArgUnpacking)
## no critic (RequirePodAtEnd)
# By using =encoding utf8 this module would require perl 5.10. No need for that!
## no critic (Documentation::RequirePODUseEncodingUTF8 )

use 5.008_001;
use strict;
use warnings;


=head1 NAME

Text::HistogramChart - Make Text Histogram (Upright Bars) Charts

=head1 VERSION

Version 0.005

=cut

#use version 0.77 (); our $VERSION = 0.003; # Require version 0.77 of module "version". Even for Perl v.5.10.0, get latest bug-fixes and API
our $VERSION = 0.005;


=head1 SYNOPSIS

Text::HistogramChart creates graphical charts for terminal displays or any other display device where bitmap graphics is not available!
You can supply the Y axel legend (vertical) values or Text::HistogramChart can calculate them from the input values.

	require Text::HistogramChart;

	my $chart = Text::HistogramChart->new();

	@values = (1, 2, 3, 4, 5, 4, 3, 2, 1, 0, -1, -2, -3, -4, -5, -4, -3, -2, -1, 0);
	@legend_values = (4, 3, 2, 1, 0, -1, -2, -3, -4);
	$chart->{'values'} = \@values;
	$chart->{'legend_values'} = \@legend_values;
	$chart->{'screen_height'} = 9;                # (height reserved for the graph.)
	$chart->{'roof_value'} = 0;                   # (active if != 0), # Arbitrarily squeeze or extend the size (height) of bars (not screen)
	$chart->{'floor_value'} = 0;                  # (the "floor" of the chart, default: 0)
	$chart->{'write_floor'} = 1;                  # (make floor visible)
	$chart->{'use_floor'} = 1;                    # (use the floor value)
	$chart->{'write_floor_value'} = 1;            # If value == floor_value, then write value (mostly "0").
	$chart->{'write_legend'} = 1;                 # (Prepend legend to each row.)
	$chart->{'legend_horizontal_width'} = 4;      # width of the space left for legend (left edge of chart)
	$chart->{'horizontal_width'} = 2;             # Horizontal width of one bar. This parameter directly influences the width of the screen (i.e. chart).
	$chart->{'write_value'} = 1;                  # (YES = 1, NO = 0, default: no; write the value on the end of the bar),
	$chart->{'write_always_over_value'} = 0;      # (YES = 1, NO = 0, default: yes; write the value only if it is too high for the graph),
	$chart->{'write_always_under_value'} = 0;     # (YES = 1, NO = 0, default: yes; write the value only if it is too low for the graph),
	$chart->{'bar_char'} = '|';                   # (default: '|')
	$chart->{'floor_char'} = '-';                 # (default '-' )
	$chart->{'over_value_char'} = '+';            # (default: '+')
	$chart->{'under_value_char'} = '_';           # (default: '-' )
	$rval = $chart->chart();
	if($rval >= 1) {
		my @ready_chart = @{$chart->{'screen'}};
		print (join '\n', @ready_chart) . "\n";
	} else {
		print "Error in creating chart: " . $chart->error_string . "\n";
	}

	# Result:
	#	4         4 5 4
	#	3       3 | | | 3
	#	2     2 | | | | | 2
	#	1   1 | | | | | | | 1
	#	0   ------------------0 ------------------0
	#	-1                      -1| | | | | | | -1
	#	-2                        -2| | | | | -2
	#	-3                          -3| | | -3
	#	-4                            -4-5-4


=head1 DESCRIPTION

Text::HistogramChart creates graphical charts for terminal displays or any other display device where bitmap graphics is not available or desired!
You can supply the Y axel legend (vertical) values or Text::HistogramChart can calculate them from the input values.


=head1 USAGE

The following variables are available to fine tune the chart
(see SYNOPSIS for an example of usage):

=over 4

=item B, B, B

The 'screen' is the area in which the chart is drawn. The size is defined with three variables.
B is the absolute Y-axis height in character rows.
B is the number of characters used for one bar (one value). If you have 10 values and
B is 3, then the length of the screen (the X-axis) is 10 * 3 = 30 characters (without legend).
Use B to define the legend width. The default for both is 5 characters.
Screen height defaults to 10 characters.

=item B
Set this to 1 if you want the legend values prepended to the left edge of the chart.

=item B, B, B, B

Set B to 1 if you want the value of each bar written to the top (or bottom if the value is negative).
Set B and B to 1 if you only want want the value written when
the value is greater than the maximum given legend value (or less than the minimum).
Set B to 1 if you want the value written when it equals to 'floor', normally when the value is 0.

=item B, B, B, B

These variables define the characters used for writing the chart
B and B are used when the value is off the scale (too big or too small).
B is the horizontal line usually at 0.
B is the normal 'bar'.

Any of these charaters can be more than one character is size.
If you want "fatter" vertical bars, just set bar_char to '||'.
Remember to set the other values to double digits as well.

=item B, B, B, B, B

With B and B you can restrict the chart into a certain 'height'.
E.g. you are measuring the CPU performance of a server. The performance is usually between 70% and 95% of total capacity.
To show the occasional drops to 0%-70% is a waste of (terminal) space. So you set
B to 95 and B to 70.
This feature not yet implemented.
Set B to 1 if you want a horizontal bar across the screen at 0.


=back


=head1 DEPENDENCIES

Requires Perl version 5.008.001.

Requires the following modules:

=over 4

=item Hash::Util

=back


=cut

use utf8;
use Hash::Util qw{lock_keys unlock_keys};

# Global creator
BEGIN {
	use Exporter ();
	our (@ISA, @EXPORT_OK, %EXPORT_TAGS);

	@ISA         = qw(Exporter DynaLoader);
	%EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
	@EXPORT_OK   = qw();
}
our @EXPORT_OK;

# Global destructor
END {
}

# CONSTANTS for this module
my $TRUE = 1;
my $FALSE = 0;
my $EMPTY_STR = q{};
my @EMPTY_ARRAY = (); ## no critic (ProhibitUselessInitialization)
my $SPACE = q{ };
my $HALF_ROW = 0.5; ## no critic (ValuesAndExpressions::ProhibitMagicNumbers)

# DEFAULTS
my $DEFAULT_SCREEN_HEIGHT = 10; ## no critic (ProhibitMagicNumbers)
my $DEFAULT_ROOF_VALUE = 0;
my $DEFAULT_BOTTOM_VALUE = 0;
my $DEFAULT_FLOOR_VALUE = 0;
my $DEFAULT_WRITE_FLOOR = 0; # FALSE
my $DEFAULT_USE_FLOOR = 0; # FALSE
my $DEFAULT_WRITE_FLOOR_VALUE = 0; # FALSE
my $DEFAULT_WRITE_LEGEND = 0;
my $DEFAULT_LEGEND_HORIZONTAL_WIDTH = 5; ## no critic (ProhibitMagicNumbers)
my $DEFAULT_HORIZONTAL_WIDTH = 5; ## no critic (ProhibitMagicNumbers)
my $DEFAULT_WRITE_VALUE = 0; # FALSE
my $DEFAULT_WRITE_ALWAYS_OVER_VALUE = 0; # FALSE
my $DEFAULT_WRITE_ALWAYS_UNDER_VALUE = 0; # FALSE

my $DEFAULT_BAR_CHAR = q{|};
my $DEFAULT_FLOOR_CHAR = q{-};
my $DEFAULT_OVER_VALUE_CHAR = q{+};
my $DEFAULT_UNDER_VALUE_CHAR = q{-};
my $DEFAULT_LEGEND_VALUES = \@EMPTY_ARRAY;
my $DEFAULT_VALUES = \@EMPTY_ARRAY;
my $DEFAULT_SCREEN = q{};
my $DEFAULT_ERROR_STRING = q{};

# GLOBALS
# No global variables



=head1 EXPORT

Text::HistogramChart is a purely object-oriented module.
No exported functions.


=head1 SUBROUTINES/METHODS

=head2 new

Creator function.

=cut

sub new {
	my $class = shift;
	my $self;
	my @self_keys = (
			'screen_height',               # (height reserved for the chart.)
			'roof_value',                  # (active if != 0), # Arbitrarily squeeze or extend the size (height) of bars (not screen)
			'bottom_value',                # (below floor, active if != 0), # Not yet implemented.
			'floor_value',                 # (the "floor" of the chart, default: 0)
			'write_floor',                 # (make floor visible)
			'use_floor',                   # (use the floor value)
			'write_floor_value',           # If value == floor_value, then write value (mostly "0").
			'write_legend',                # (Prepend legend to each row.)
			'legend_horizontal_width',     # width of the space left for legend (left edge of chart)
			'horizontal_width',            # Horizontal width of one bar. This parameter directly influences the width of the screen (i.e. chart).
			'write_value',                 # (YES = 1, NO = 0, default: no; write the value on the end of the bar),
			'write_always_over_value',     # (YES = 1, NO = 0, default: yes; write the value only if it is too high for the graph),
			'write_always_under_value',    # (YES = 1, NO = 0, default: yes; write the value only if it is too low for the graph),
			'bar_char',                    # (default: '|')
			'floor_char',                  # (default: '-' )
			'over_value_char',             # (default: '+'; overruled by write_value and write_always_over_value)
			'under_value_char',            # (default: '-'; overruled by write_value and write_always_under_value)
			'legend_values',               # array of legend values (numbers). Pointer to.
			'values',                      # array of values (numbers). Pointer to.
			'screen',                      # The result: array of strings. Pointer to.
			'error_string',                # A meaningful error!
	);
	lock_keys(%{$self}, @self_keys);
	$self->{'screen_height'} = $DEFAULT_SCREEN_HEIGHT;
	$self->{'roof_value'} = $DEFAULT_ROOF_VALUE;
	$self->{'bottom_value'} = $DEFAULT_BOTTOM_VALUE;
	$self->{'floor_value'} = $DEFAULT_FLOOR_VALUE;
	$self->{'write_floor'} = $DEFAULT_WRITE_FLOOR;
	$self->{'use_floor'} = $DEFAULT_USE_FLOOR;
	$self->{'write_floor_value'} = $DEFAULT_WRITE_FLOOR_VALUE;
	$self->{'write_legend'} = $DEFAULT_WRITE_LEGEND;
	$self->{'legend_horizontal_width'} = $DEFAULT_LEGEND_HORIZONTAL_WIDTH;
	$self->{'horizontal_width'} = $DEFAULT_HORIZONTAL_WIDTH;
	$self->{'write_value'} = $DEFAULT_WRITE_VALUE;
	$self->{'write_always_over_value'} = $DEFAULT_WRITE_ALWAYS_OVER_VALUE;
	$self->{'write_always_under_value'} = $DEFAULT_WRITE_ALWAYS_UNDER_VALUE;

	$self->{'bar_char'} = $DEFAULT_BAR_CHAR;
	$self->{'floor_char'} = $DEFAULT_FLOOR_CHAR;
	$self->{'over_value_char'} = $DEFAULT_OVER_VALUE_CHAR;
	$self->{'under_value_char'} = $DEFAULT_UNDER_VALUE_CHAR;
	$self->{'legend_values'} = $DEFAULT_LEGEND_VALUES;
	$self->{'values'} = $DEFAULT_VALUES;
	$self->{'screen'} = $DEFAULT_SCREEN;
	$self->{'error_string'} = $DEFAULT_ERROR_STRING;

	unlock_keys(%{$self});
	my $blessed_ref = bless $self, $class;
	lock_keys(%{$self}, @self_keys);
	return $blessed_ref;
}

=head2 chart

Create the chart. Writes the ready chart into $self->{'screen'}.
The ready chart is an array of strings without linefeed.
Returns >= 1, if successful, else $self->{'error_string'} contains the error.

=cut

sub chart {
	my $return_value = 1;

	my $self = shift;

	my @values = @{$self->{'values'}};
	my @legend_values;
	my $horizontal_width_empty = $EMPTY_STR;
	while(length $horizontal_width_empty < $self->{'horizontal_width'}) {
		$horizontal_width_empty .= $SPACE;
	}

	my @output_rows;
	# If user wants, write only the legend.
	# Always create the legend first so you know which rows have which values!
	# If user gives the legend values (parameter LEGEND_VALUES)
	# then all the better for you (no need to calculate the legend yourself).
	# But only write the legend if user demands it (parameter WRITE_LEGEND).
	# Even without writing the legend, the legend values define the distance between rows.
	my $sprf_format = q{%-} . $self->{'legend_horizontal_width'} . q{s};
	if(defined $self->{'legend_values'} && scalar @{$self->{'legend_values'}} > 0) {
		@legend_values = @{$self->{'legend_values'}};
		if(scalar(@legend_values) != $self->{'screen_height'}) {
			$self->{'error_string'} = 'Screen height must be equal to the number of legend values!';
			return 0;
		}
		@legend_values = sort {$a <=> $b} @legend_values; # Sort them to be sure
	}
	else {
		my $highest_value = 0;
		if($self->{'roof_value'} != 0) {
			$highest_value = $self->{'roof_value'};
		}
		else {
			foreach my $value (@values) {
				if($value > $highest_value) {
					$highest_value = $value;
				}
			}
		}
		my $lowest_value = 0;
		if($self->{'bottom_value'} != 0) {
			$lowest_value = $self->{'bottom_value'};
		}
		else {
			foreach my $value (@values) {
				if($value < $lowest_value) {
					$lowest_value = $value;
				}
			}
		}
		my $rows_for_one = $self->{'screen_height'} / $highest_value;
		my $amount_per_row = $highest_value / $self->{'screen_height'};
		#my $rows_for_one = $self->{'screen_height'} / ($highest_value - $lowest_value + 1); //TODO
		#my $amount_per_row = ($highest_value - $lowest_value + 1) / $self->{'screen_height'}; //TODO

		# Make a legend based on lowest and highest value in @values
		my $screen_top_row = $self->{'screen_height'} - 1;
		my $screen_bottom_row = 0;
		#my $screen_top_row = $highest_value - $lowest_value; //TODO
		#my $screen_bottom_row = 0; //TODO
		for(my $i_row = $screen_bottom_row; $i_row <= $screen_top_row; $i_row++) {
			push @legend_values, (sprintf $sprf_format, int(($i_row + 1) * $amount_per_row + $HALF_ROW));
			#push @legend_values, (sprintf $sprf_format, int(($i_row + $lowest_value) * $amount_per_row + 0.5)); //TODO
		}
	}
	if($self->{'write_legend'} == 1) {
		for(my $i_row = $self->{'screen_height'} - 1; $i_row >= 0; $i_row--) { ## no critic (ControlStructures::ProhibitCStyleForLoops)
			$output_rows[$i_row] .= sprintf $sprf_format, int $legend_values[$i_row];
		}
	}

	# Now the values
	# We write one pillar at a time: one value = one pillar!
	# So, we write from left to right, one pillar at a time!
	# We write the pillar starting from the bottom.
	my $screen_top_row = $self->{'screen_height'} - 1;
	my $screen_bottom_row = 0;
	my $screen_floor_row = $screen_bottom_row;
	if($self->{'use_floor'} == 1) {
		for(0..@legend_values-1) {
			if($legend_values[$_] == $self->{'floor_value'}) {
				$screen_floor_row = $_;
			}
		}
	}
	foreach my $value (@values) {
		for(my $i_row = $screen_bottom_row; $i_row <= $screen_top_row; $i_row++) {
			if($value != $self->{'floor_value'}) { # If value == 0, just write spaces.
				if($i_row == $screen_bottom_row) { ## no critic (ControlStructures::ProhibitCascadingIfElse)
					if($i_row < $screen_floor_row) {
						if($value > $legend_values[$i_row]) { # Write empty space
							$output_rows[$i_row] .= $horizontal_width_empty;
						}
						elsif($value <= $legend_values[$i_row]) { # Write value
							if(length($value) > $self->{'horizontal_width'}) { # Doesn't fit on the row.
								$output_rows[$i_row] .= center_text(
										$self->{'write_always_under_value'} ? $self->{'under_value_char'} : ($self->{'write_value'} ? $value : $self->{'bar_char'}),
										$self->{'horizontal_width'}, $SPACE, 'right');
							}
							else {
								$output_rows[$i_row] .= center_text(
										$self->{'write_always_under_value'} ? $value : ($self->{'write_value'} ? $value : $self->{'bar_char'}),
										$self->{'horizontal_width'}, $SPACE, 'right');
							}
						}
						else {
						}
					}
					elsif($i_row >= $screen_floor_row) {
						if($value >= $legend_values[$i_row + 1]) { # Write bar char
							$output_rows[$i_row] .= center_text($self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
						}
						elsif($value >= $legend_values[$i_row] && $value < $legend_values[$i_row + 1]) { # Write value
							$output_rows[$i_row] .= center_text($self->{'write_value'} ? $value : $self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
						}
						elsif($value < $legend_values[$i_row] && $value >= $self->{'floor_value'}) { # Write value maybe
							$output_rows[$i_row] .= center_text(
									$self->{'write_always_under_value'} ? $value : '',
									$self->{'horizontal_width'}, $SPACE, 'right');
						}
						elsif($value < $legend_values[$i_row] && $value < $self->{'floor_value'}) { # Write value
							$output_rows[$i_row] .= center_text($self->{'write_value'} ? $value : $self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
						}
						else {
						}
					}
					else {
					}
				}

				# (Possible) middle rows (floor down)
				elsif($i_row < $screen_floor_row && $i_row > $screen_bottom_row) {
					if($value <= $legend_values[$i_row - 1]) { # Write bar char
						$output_rows[$i_row] .= center_text($self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					elsif($value <= $legend_values[$i_row] && $value > $legend_values[$i_row - 1]) { # Write value
						$output_rows[$i_row] .= center_text($self->{'write_value'} ? $value : $self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					elsif($value > $legend_values[$i_row]) { # Write white space
						$output_rows[$i_row] .= $horizontal_width_empty;
					}
					else {
					}
				}

				# Floor row
				elsif($i_row == $screen_floor_row) {
					if($self->{'write_floor'} == 1) {
						$output_rows[$i_row] .= center_text('-', $self->{'horizontal_width'}, "-", 'right');
					}
					else {
						if($value > $legend_values[$i_row - 1] && $value < $legend_values[$i_row + 1]) { # Write value
							$output_rows[$i_row] .= center_text($self->{'write_value'} ? $value : $self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
						}
						else { # Write bar char
							$output_rows[$i_row] .= center_text($self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
						}
					}
				}

				# (Possible) middle rows (floor up)
				elsif($i_row > $screen_floor_row && $i_row < $screen_top_row) {
					if($value >= $legend_values[$i_row + 1]) { # Write bar char
						$output_rows[$i_row] .= center_text($self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					elsif($value >= $legend_values[$i_row] && $value < $legend_values[$i_row + 1]) { # Write value
						$output_rows[$i_row] .= center_text($self->{'write_value'} ? $value : $self->{'bar_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					elsif($value < $legend_values[$i_row]) { # Write white space
						$output_rows[$i_row] .= $horizontal_width_empty;
					}
					else {
					}
				}

				# Top row, here value is only >= or
				elsif($i_row == $screen_top_row) {
					if($value >= $legend_values[$i_row]) { # Write value or bar char
						if(length($value) > $self->{'horizontal_width'}) { # Doesn't fit on the row.
							$output_rows[$i_row] .= center_text(
									$self->{'write_always_over_value'} ? $self->{'over_value_char'} : ($self->{'write_value'} ? $value : $self->{'bar_char'}),
									$self->{'horizontal_width'}, $SPACE, 'right');
						}
						else {
							$output_rows[$i_row] .= center_text(
									$self->{'write_always_over_value'} ? $value : ($self->{'write_value'} ? $value : $self->{'bar_char'}),
									$self->{'horizontal_width'}, $SPACE, 'right');
						}
					}
					elsif($value < $legend_values[$i_row]) { # Write white space
						$output_rows[$i_row] .= $horizontal_width_empty;
					}
					else {
					}
				}
				else {
				}
			}
			else { # $value is same as $self->{'floor_value'}
				if($self->{'floor_value'} == $legend_values[$i_row]) { # This is the floor row, the "0" row.
					if($self->{'write_floor_value'} == 1) {
						$output_rows[$i_row] .= center_text($value, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					elsif($self->{'write_floor'}) {
						$output_rows[$i_row] .= center_text($self->{'floor_char'}, $self->{'horizontal_width'}, $SPACE, 'right');
					}
					else {
						$output_rows[$i_row] .= $horizontal_width_empty;
					}
				}
				else {
					$output_rows[$i_row] .= $horizontal_width_empty;
				}
			}
		}
	}
	# Now we have to flip the order!
	my @reversed_rows;
	foreach my $screen_row (@output_rows) {
		unshift @reversed_rows, $screen_row;
	}
	$self->{'screen'} = \@reversed_rows;

	# Clean up
	return $return_value;
}

=head1 INTERNAL SUBROUTINES

=head2 center_text

Center a string into a string buffer. Return the buffer.
Parameters: text to be centered, field width, fill character (default: " "), start direction (default: left).
If text is longer than field width, it is not truncated!

=cut

sub center_text {
	my $text = $_[0];
	my $field_width = $_[1];
	my $fill_character = ($_[2] ? $_[2] : $SPACE);
	my $start_direction = ($_[3] ? $_[3] : 'left'); ## no critic (ProhibitMagicNumbers)
	my $next_add_direction = $start_direction;
	# MODIFY BUFFER
	while(length($text) < $field_width) {
		if($next_add_direction eq 'left') {
			$text = $fill_character . $text;
			$next_add_direction = 'right'
		}
		else {
			$text = $text . $fill_character;
			$next_add_direction = 'left'
		}
	}

	return $text;
}

=head1 AUTHOR

Mikko Koivunalho, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Text::HistogramChart


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS

None.


=head1 DIAGNOSTICS

None.


=head1 CONFIGURATION AND ENVIRONMENT

Please see the examples.


=head1 INCOMPATIBILITIES

None known.


=head1 BUGS AND LIMITATIONS

Plenty I'm sure.
Using roof_value and bottom_value together to restrict the bars into a certain scope is not yet implemented.


=head1 LICENSE AND COPYRIGHT

Copyright 2012 Mikko Koivunalho.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Text::HistogramChart