Benchmark-Harness-Graph
view release on metacpan or search on metacpan
sub new {
my $cls = shift;
my $self = {
'axislist' => []
# Defaults that will be overridden by parameters given to this new()
,'x_legend' => 'Time - mins', 'x_pixels' => 600, 'y_pixels' => 300
,'y1_legend' => 'Memory | MB', 'y1_min_value' => 0, 'y1_color' => '#ff0000'
,'y2_legend' => 'CPU | %', 'y2_max_value' => 0, 'y2_color' => '#00dd00'
};
my @positionalParameterNames = qw(source x_pixels y_pixels x_max_value y1_max_value y2_max_value);
for ( @_ ) {
if ( ref($_) eq 'HASH' ) {
for my $k ( keys %$_ ) {
$self->{$k} = $_->{$k};
}
} else {
$self->{shift @positionalParameterNames} = $_;
}
}
# If no schema was named, try to extract it from the XML file.
unless ( $self->{schema} ) {
open TMP, "<$self->{source}" or die "Can't open $self->{source}: $!";
while ( <TMP> ) {
if ( m{xsi\:noNamespaceSchemaLocation=(['"])(.*?)\1} ) {
my $attr = $2;
$attr =~ m{([\w\d]+)\.xsd};
$self->{schema} = $1;
close TMP;
last;
}
}
}
eval "use Benchmark::Harness::Graph::$self->{schema}"; die $@ if $@;
my $graph = eval "new Benchmark::Harness::Graph::$self->{schema}(\$self)"; die $@ if $@;
return $graph->generate();
}
### ################################################################################################
sub generate {
my ($self) = @_;
my $axislist = $self->{axislist};
# Plot the graph.
my $my_graph = new GD::Graph::lines($self->{x_pixels}, $self->{y_pixels});
my ($x_axis, $y1_axis, $y2_axis) = ($axislist->[0], $axislist->[1], $axislist->[2]);
$my_graph->set(
'two_axes' => 1, #'no_axes' => 1,
'x_label_skip' => 1,
'y1_label_skip' => 1,
'y2_label_skip' => 1,
'title' => undef, # as for the functions entry/exit lines, below.
'x_ticks' => 'true', 'x_tick_number' => 12,
'y1_ticks' => 'true', 'y1_tick_number' => 12,
'y2_ticks' => 'true', 'y2_tick_number' => 10,
'transparent' => 1, 'box_axis' => 0, 'line_width' => 3,
'x_max_value' => $self->{x_max_value}, 'x_min_value' => $self->{x_min_value},
'y1_max_value' => $self->{y1_max_value}, 'y1_min_value' => $self->{y1_min_value},
'y2_max_value' => $self->{y2_max_value}, 'y2_min_value' => $self->{y2_min_value},
);
$my_graph->plot([$x_axis->{data}, $y1_axis->{data}, $y2_axis->{data}]) or die $my_graph->error;
# Plot the function entries / exits
$my_graph->set(
'two_axes' => 1, 'no_axes' => 0,
'x_label_skip' => 1,
'y1_label_skip' => 1,
'y2_label_skip' => 1,
'title' => undef,
'x_ticks' => 'true', 'x_tick_number' => 12,
'y1_ticks' => 'true', 'y1_tick_number' => 12,
'y2_ticks' => 'true', 'y2_tick_number' => 10,
'transparent' => 1, 'box_axis' => 0, 'line_width' => 2,
);
my @needsLegends = ( $x_axis, $y1_axis, $y2_axis ); # We'll build legends from this array later.
my @funcDataColors = ($y1_axis->{color}); # $graph->plot() needs this, below.
# Plot the function entries / exits
my @nullAxis; map { push @nullAxis, undef } @{$x_axis->{data}};
my $allAxis = [$x_axis->{data}, \@nullAxis];
for (my $axisIdx = 3; $axisIdx < $#{$axislist}; $axisIdx += 1 ) {
my $axis = $axislist->[$axisIdx];
push @needsLegends, $axis;
my $funcData = $axis->{data};
push @funcDataColors, $axis->{color};
$self->Normalize($y1_axis);
push @$allAxis, $axis->{data};
}
$my_graph->set( dclrs => \@funcDataColors);
$my_graph->plot($allAxis) or die $my_graph->error;
my $ext = $my_graph->export_format;
my $filnam = "$self->{source}";
$filnam =~ s{\.[\w\d]+$}{};
open(PNG, ">$filnam.$ext") or die "Cannot open '$filnam.$ext' for write: $!";
binmode PNG;
print PNG $my_graph->gd->$ext();
close PNG;
$self->{graphFilename} = "$filnam.$ext";
# Here is our HTML output file
$self->{outFilename} = "$filnam.htm";
open HTM, ">$self->{outFilename}";
print HTM '<html><head>';
# Print any script (e.g., javascript) into the <head>
print HTM $self->htmlScript();
# Print any style (e.g., css) into the <head>
print HTM $self->htmlStyle();
print HTM '</head><body>';
# print <img> of the graph and the legends surrounding it.
print HTM $self->htmlGraph();
print HTM '<tr><td align=center colspan=5><iframe id=detailview src=benchmarkHarnessGraphNullFrame.htm frameborder=0 height=80 width=500></iframe></td></tr>';
print HTM <<EOT;
<tr><td colspan=5><table width=100% align=center>
<tr>
<td width=60%>Subroutine</td>
<td align=right width=10%>first</td>
<td align=right width=10%>last</td>
<td align=right width=10%>count</td>
<td align=right width=10%>total tm</td>
</tr>
EOT
for (my $axisIdx = 3; $axisIdx < $#{$axislist}; $axisIdx += 1 ) {
my $axis = $axislist->[$axisIdx];
my $color = $axis->{color} || 'black';
my $countEntry = $axis->{count_entry};
my $firstEntry = int($axis->{first_entry}+0.50);
( run in 2.333 seconds using v1.01-cache-2.11-cpan-7fcb06a456a )