/usr/share/perl5/CGI/Application/Plugin/DBIProfile/Graph/HTML/Horizontal.pm is in libcgi-application-plugin-dbiprofile-perl 0.07-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | package CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal;
###############################################################################
# Required inclusions.
###############################################################################
use strict;
use warnings;
use HTML::Template;
use List::Util qw(max);
###############################################################################
# Set up the colours we use for the bar graphs and the row backgrounds.
###############################################################################
my @COLOURS = qw(
2856E0 8DA6F0 C5D1F7 445896 222C4B 687AB0 9FA9C8
FFAB2E FFD596 FFEACB AA854D 554227 BFA071 DFCDB1
);
my @ROW_BGS = qw(
FFFFFF EEEEFF
);
###############################################################################
# Subroutine: build_graph($self, %opts)
# Parameters: $self - CAP::DBIProfile object
# %opts - Graphing options
###############################################################################
# Builds a horizontal bar graph based on the provided '%opts', and returns the
# HTML for that graph back to the caller.
###############################################################################
sub build_graph {
my ($self, %opts) = @_;
my $data = $opts{'data'};
my $tags = $opts{'tags'};
# calculate widths for the bar graphs
my $max = max( @{$data} ) || 1;
my @widths = map { ($_ / $max) * 300 } @{$data};
# assemble data set for HTML::Template
my $cols = [
map { { 'width' => $widths[$_],
'value' => $data->[$_],
'tag' => $tags->[$_],
'colour' => $COLOURS[ $_ % scalar @COLOURS ],
'row_bg' => $ROW_BGS[ $_ % scalar @ROW_BGS ],
} }
(0 .. $#widths)
];
# template body
my $body = q{
<table width="400" border="0" cellpadding="2" cellspacing="0" style="font-size: 0.75em">
<tbody>
<tmpl_loop name="cols">
<tr style="background-color: #<tmpl_var name="row_bg">">
<td width="20" align="left" ><tmpl_var name="tag"></td>
<td width="300" align="left" ><div style="background-color: #<tmpl_var name="colour">; width: <tmpl_var name="width">px;"> </div></td>
<td width="80" align="right"><tmpl_var name="value"></td>
</tr>
</tmpl_loop>
</tbody>
</table>
};
# generate report using HTML::Template
my $tmpl = HTML::Template->new(
die_on_bad_params => 1,
loop_context_vars => 1,
scalarref => \$body,
);
$tmpl->param('cols', $cols);
return $tmpl->output();
}
1;
=head1 NAME
CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal - Horizontal bar graph for CAP::DBIProfile
=head1 SYNOPSIS
# In startup.pl, or your CGI::Application class
BEGIN {
$ENV{'CAP_DBIPROFILE_GRAPHMODULE'} = 'CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal';
};
=head1 DESCRIPTION
C<CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal> implements a
basic/simple horizontal bar graph for C<CGI::Application::Plugin::DBIProfile>.
=head1 AUTHOR
Graham TerMarsch (cpan@howlingfrog.com)
=head1 COPYRIGHT
Copyright (C) 2007, Graham TerMarsch. All Rights Reserved.
This is free software; you can redistribute it and/or modify it under the same
license as Perl itself.
=head1 SEE ALSO
L<CGI::Application::Plugin::DBIProfile>,
L<CGI::Application::Plugin::DBIProfile::Graph::HTML>.
=cut
|