SVG-TT-Graph-0.25/ 000755 000765 000024 00000000000 12513274446 013415 5 ustar 00leo staff 000000 000000 SVG-TT-Graph-0.25/Changes 000755 000765 000024 00000014116 12513274331 014707 0 ustar 00leo staff 000000 000000 Revision history for Perl extension SVG::TT::Graph.
0.25 Tue 14 Apr 2015 21:26:11
- Make TimeSeries accept max_scale_value. (FGasper)
- Teach TimeSeries to accept a time zone for date display. (FGasper)
0.24 Wed 9 Jul 2014 19:23:11
- Added config.show_path_title to control whether to include new
title attribute in path tag, default to '0' (mikejbwhoo)
- Added TITLE attribute to PATH tag in SHOW DATA section (mikejbwhoo)
- Added config.show_title_fields to allow for fields array element to
be shown instead of title attribute used in add_data, looks nice
when creating non-overlapping bars, default to '0' (mikejbwhoo)
- Above changes made only to Pie, Bar, BarHorizontal, BarLine
(mikejbwhoo)
0.23 Mon 4 Feb 2013 21:14:40
- fix division by zero errors in all graph types (Carsten Wolff)
- Doc clarification (elnjensen)
0.22 Sun 14 Oct 2012 09:43:58
- Link to github for issue tracking
- Allow reversed y-axis (elnjensen)
- Add missing class for data point labels (snabb)
0.21
- New type of graph available: XY (written by Florent Angly, but largely based
on the TimeSeries module by David Meibusch)
0.20
- Fixed wrong formatting of Y labels in SVG::TT:Graph::BarHorizontal (patch by
Erin Schönhals)
- Fixed wrong formatting of Y labels in SVG::TT::Graph::Bar
0.19
- Fixed warning messages with missing data title (#69691, reported by
dean@fragfest.com.au, patch by Florent Angly)
0.18 - Thu 5 Jan 2012
- Added format_x_axis, format_y_axis callback options (Eric Johnson)
0.17 - Wed Jul 20 2011
- By default, do not compress() or tidy() the SVG
- Line and Timeseries graphs now have points styled as '.dataPointNN',
consistently with BarLine graphs (patch from Henrik Pauli, #67834)
- Added a max_scale_value option to set the maximum value for the Y axis of
Bar and Line graphs (patch by Bryce and Henrik Pauli, #20475)
- Repackaged module without extra files (#56718)
0.16 - Sun Apr 18 2010
- Javascript code in the piechart and timeseries put into a CDATA tag
0.15 - Sat Apr 17 2010
- Method get_template() moved from SVG::TT::Graph::* to SVG::TT::Graph to avoid redundancy
- Fixed bug in get_template(). The DATA filehandle is now read from the beginning
at each get_template call
- Makefile.PL does not use autoinstall aymore (not a good practice for CPAN modules)
- Rollover improvements in piechart
0.14 - Mon Apr 05 2010
- Fixed some unit tests and the URL of the repository
0.13 - Sat Apr 03 2010
- Revised TT templates warnings due to undef values (bug # 44115)
- Fixed the "used only once" warnings (bug # 43854, thank you Ia Hun)
- Introduced a new method to use random colors instead of the 12 predefined
colors. Along with the dynamic allocation of the number of style elements,
this allows an unlimited number of dataseries
- Added Javascript code to display field name when the mouse rolls over a
piechart wedge
- Implemented an optional new method to tidy the formatting of the SVG files
(using XML::Tidy)
- Replaced carriage returns by line feeds because it is more portable
(http://www.webmasterworld.com/forum13/4067.htm)
- Did documentation, unit testing and packaging revisions
- Misc little code touch ups
0.12 - Mon Feb 16 12:00:00 EST 2009
- Missed updating the versions for some of the sub libraries.
0.11 - Sun Feb 15 22:54:00 EST 2009
- Applied patches:
http://rt.cpan.org/Ticket/Display.html?id=38441 - Ampersands in Fields cause XML error
http://rt.cpan.org/Ticket/Display.html?id=43326 - Multiple data sets in Bar.pm will now show stacked graphs
http://rt.cpan.org/Ticket/Display.html?id=43325 - Allow toggling the display of data on TimeSeries
0.10 - Mon Apr 28 21:07:30 BST 2008
- Applied patches:
http://rt.cpan.org/Ticket/Display.html?id=34491
http://rt.cpan.org/Ticket/Display.html?id=22896
http://rt.cpan.org/Ticket/Display.html?id=20828
http://rt.cpan.org/Ticket/Display.html?id=20475
0.09
- Applied path patch for Firefox from Pat Ekman for Pie
- patched other modules so Firefox works (doesn't like comma's in a path)
0.08
- Fix stylesheet for Pie
0.07
Help from Yanick with the following:
- Bug fixes:
#7342 (bad default stylesheet class)
#8680 (Typo in defaut Stylesheet for SVG::TT::Graph::TimeSeries)
#7541 (BarHorizontal)
#7549 (Character width setting in BarHorizontal)
0.06
- Put in comment so people know where to copy the
style sheet from (e.g. not including the
[% END %]
[% w = config.width %]
[% h = config.height %]
[% x = 0 %]
[% y = 0 %]
[% char_width = 9 %]
[% half_char_height = 2.5 %]
[% min_value = 99999999999 %]
[% max_value = 0 %]
[% max_key_size = 0 %]
[% max_x_label_size = 0 %]
[% FOREACH field = config.fields %]
[% IF max_x_label_size < field.length %]
[% max_x_label_size = field.length %]
[% END %]
[% max_y_value = 0 %]
[% FOREACH dataset = data %]
[% IF dataset.data.$field != '' %]
[% max_y_value = max_y_value + dataset.data.$field %]
[% END %]
[% IF dataset.title %]
[% IF max_key_size < dataset.title.length %]
[% max_key_size = dataset.title.length %]
[% END %]
[% END %]
[% END %]
[% IF min_value > max_y_value %]
[% min_value = max_y_value %]
[% END %]
[% IF max_value < max_y_value %]
[% max_value = max_y_value %]
[% END %]
[% END %]
[% IF config.show_x_labels %][% h = h - 20 %][% END %]
[% max_x_label_length = 0 %]
[% IF config.rotate_x_labels %]
[% max_x_label_length = max_x_label_size * char_width %]
[% h = h - max_x_label_length %]
[% END %]
[% stagger = 0 %]
[% IF config.stagger_x_labels %]
[% stagger = 17 %]
[% h = h - stagger %]
[% END %]
[% IF config.show_x_title %][% h = h - 25 - stagger %][% END %]
[% IF config.show_y_labels %][% h = h - 10 %][% y = y + 10 %][% END %]
[% IF config.show_graph_title %][% h = h - 25 %][% y = y + 25 %][% END %]
[% IF config.show_graph_subtitle %][% h = h - 10 %][% y = y + 10 %][% END %]
[% key_box_size = 12 %]
[% key_padding = 5 %]
[% IF config.key && config.key_position == 'right' %]
[% w = w - (max_key_size * (char_width - 1)) - (key_box_size * 3 ) %]
[% ELSIF config.key && config.key_position == 'bottom' %]
[% IF data.size < 4 %]
[% h = h - ((data.size + 1) * (key_box_size + key_padding))%]
[% ELSE %]
[% h = h - (4 * (key_box_size + key_padding))%]
[% END %]
[% END %]
[% IF config.min_scale_value || config.min_scale_value == '0' %]
[% min_scale_value = config.min_scale_value %]
[% ELSE %]
[% min_scale_value = min_value %]
[% END %]
[% IF config.max_scale_value || config.max_scale_value == '0' %]
[% max_scale_value = config.max_scale_value %]
[% ELSE %]
[% max_scale_value = max_value %]
[% END %]
[% base_line = h + y %]
[% IF (max_scale_value - min_scale_value) == 0 %]
[% top_pad = 10 %]
[% ELSE %]
[% top_pad = (max_scale_value - min_scale_value) / 20 %]
[% END %]
[% scale_range = (max_scale_value + top_pad) - min_scale_value %]
[% IF config.scale_divisions %]
[% scale_division = config.scale_divisions %]
[% ELSE %]
[% scale_division = scale_range / 10 FILTER format('%2.01f') %]
[% END %]
[% IF config.scale_integers %]
[% IF scale_division < 1 %]
[% scale_division = 1 %]
[% ELSIF scale_division.match('.') %]
[% scale_division = scale_division FILTER format('%2.0f') %]
[% END %]
[% END %]
[% dx = config.fields.size %]
[% IF dx == 0 %]
[% dx = 1 %]
[% END %]
[% data_widths_x = w / dx %]
[% dw = data_widths_x FILTER format('%2.02f') %]
[% half_label_width = (config.fields.0.length / 2) * char_width %]
[% space_b4_y_axis = 0 %]
[% IF half_label_width > (dw / 2) %]
[% space_b4_y_axis = half_label_width - (dw / 2) %]
[% IF config.key && config.key_position == 'right' %]
[% w = w - space_b4_y_axis %]
[% ELSE %]
[% w = w - (space_b4_y_axis * 2) %]
[% END %]
[% x = x + space_b4_y_axis %]
[% END %]
[% max_value_length = max_value.length %]
[% max_value_length_px = max_value_length * char_width %]
[% IF config.show_y_labels && space_b4_y_axis < max_value_length_px %]
[% IF max_value_length < 2 %]
[% w = w - (max_value_length * (char_width * 2)) - char_width %]
[% x = x + (max_value_length * (char_width * 2)) + char_width %]
[% ELSE %]
[% w = w - max_value_length_px + char_width %]
[% x = x + max_value_length_px + char_width %]
[% END %]
[% END %]
[% IF config.show_y_title && space_b4_y_axis < max_value_length_px %]
[% w = w - 25 %]
[% x = x + 25 %]
[% END %]
[% dx = config.fields.size %]
[% IF dx == 0 %]
[% dx = 1 %]
[% END %]
[% data_widths_x = w / dx %]
[% dw = data_widths_x.match('(\d+[\.\d\d])').0 %]
[% i = dw %]
[% count = 0 %]
[% IF config.bar_gap %]
[% bar_gap = 10 %]
[% IF dw < bar_gap %]
[% bar_gap = dw / 2 %]
[% END %]
[% ELSE %]
[% bar_gap = 0 %]
[% END %]
[% stagger_count = 0 %]
[% IF config.show_x_labels %]
[% FOREACH field = config.fields %]
[% field_txt = config.x_label_formatter(field) %]
[% IF count == 0 %]
[% field_txt %]
[% i = i - dw %]
[% ELSE %]
[% IF stagger_count == 2 %]
[% field_txt %]
[% stagger_count = 0 %]
[% ELSE %]
[% field_txt %]
[% END %]
[% END %]
[% i = i + dw %]
[% count = count + 1 %]
[% stagger_count = stagger_count + 1 %]
[% END %]
[% END %]
[% dy = scale_range / scale_division %]
[% IF dy == 0 %]
[% dy = 1 %]
[% END %]
[% y_marker_height = h / dy %]
[% dy = y_marker_height.match('(\d+[\.\d\d])').0 %]
[% count = 0 %]
[% y_value = min_scale_value %]
[% IF config.show_y_labels %]
[% WHILE (dy * count) < h %]
[% y_value_txt = config.y_label_formatter(y_value) %]
[% IF count == 0 %]
[% y_value_txt %]
[% ELSE %]
[% y_value_txt %]
[% END %]
[% y_value = y_value + scale_division %]
[% count = count + 1 %]
[% END %]
[% END %]
[% IF config.show_x_title %]
[% IF !config.show_x_labels %]
[% y_xtitle = 15 %]
[% ELSE %]
[% y_xtitle = 35 %]
[% END %]
[% config.x_title %]
[% END %]
[% IF config.show_y_title %]
[% IF config.y_title_text_direction == 'tb' %]
[% config.y_title %]
[% ELSE %]
[% config.y_title %]
[% END %]
[% END %]
[% bar_width = dw - bar_gap %]
[% divider = dy / scale_division %]
[% xcount = 0 %]
[% FOREACH field = config.fields %]
[% dcount = 1 %]
[% start_x = base_line %]
[% FOREACH dataset = data %]
[% IF config.show_path_title %]
[% IF config.show_title_fields %]
[% dataset.data.$field %] - [% field %]
[% ELSE %]
[% dataset.data.$field %] - [% dataset.title %]
[% END %]
[% ELSE %]
[% END %]
[% IF config.show_data_values %]
[% dataset.data.$field %]
[% END %]
[% start_x = start_x - (dataset.data.$field * divider) %]
[% dcount = dcount + 1 %]
[% END %]
[% xcount = xcount + 1 %]
[% END %]
[% key_count = 1 %]
[% key_padding = 5 %]
[% IF config.key && config.key_position == 'right' %]
[% FOREACH dataset = data %]
[% dataset.title %]
[% key_count = key_count + 1 %]
[% END %]
[% ELSIF config.key && config.key_position == 'bottom' %]
[% y_key = base_line %]
[% IF config.show_x_title %][% y_key = y_key + 25 %][% END %]
[% IF config.rotate_x_labels && config.show_x_labels %]
[% y_key = y_key + max_x_label_length %]
[% ELSIF config.show_x_labels && stagger < 1 %]
[% y_key = y_key + 20 %]
[% END %]
[% y_key_start = y_key %]
[% x_key = x %]
[% FOREACH dataset = data %]
[% IF key_count == 4 || key_count == 7 || key_count == 10 %]
[% x_key = x_key + 200 %]
[% y_key = y_key - (key_box_size * 4) - 2 %]
[% END %]
[% dataset.title %]
[% key_count = key_count + 1 %]
[% END %]
[% END %]
[% IF config.show_graph_title %]
[% config.graph_title %]
[% END %]
[% IF config.show_graph_subtitle %]
[% IF config.show_graph_title %]
[% y_subtitle = 30 %]
[% ELSE %]
[% y_subtitle = 15 %]
[% END %]
[% config.graph_subtitle %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/BarHorizontal.pm 000755 000765 000024 00000057636 12410061742 021337 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::BarHorizontal;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
=head1 NAME
SVG::TT::Graph::BarHorizontal - Create presentation quality SVG horizontal bar graphs easily
=head1 SYNOPSIS
use SVG::TT::Graph::BarHorizontal;
my @fields = qw(Jan Feb Mar);
my @data_sales_02 = qw(12 45 21);
my $graph = SVG::TT::Graph::BarHorizontal->new({
'height' => '500',
'width' => '300',
'fields' => \@fields,
});
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG horitonzal bar graphs. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, data elements at each point,
title, subtitle etc.
=head1 METHODS
=head2 new()
use SVG::TT::Graph::BarHorizontal;
# Field names along the X axis
my @fields = qw(Jan Feb Mar);
my $graph = SVG::TT::Graph::BarHorizontal->new({
# Required
'fields' => \@fields,
# Optional - defaults shown
'height' => '500',
'width' => '300',
'show_data_values' => 1,
'scale_divisions' => '',
'min_scale_value' => '0',
'bar_gap' => 1,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'y_label_formatter' => sub { return @_ },
'x_label_formatter' => sub { return @_ },
'show_path_title' => 0,
'show_title_fields' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right',
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'random_colors' => 0,
});
The constructor takes a hash reference, only fields (the names for each
field on the X axis) MUST be set, all other values are defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_sales_02 = qw(12 45 21);
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
This method allows you to add data to the graph object.
It can be called several times to add more data sets in,
but the likelihood is you should be using SVG::TT::Graph::Line
as it won't look great!
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total width
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the defaut internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet
=item show_data_values()
Show the value of each element of data on the graph
=item bar_gap()
Whether to have a gap between the bars or not, default
is '1', set to '0' if you don't want gaps.
=item min_scale_value()
The point at which the Y axis starts, defaults to '0',
if set to '' it will default to the minimum data value.
=item show_x_labels()
Whether to show labels on the X axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item stagger_x_labels()
This puts the labels at alternative levels so if they
are long field names they will not overlap so easily.
Default it '0', to turn on set to '1'.
=item show_y_labels()
Whether to show labels on the Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item scale_integers()
Ensures only whole numbers are used as the scale divisions.
Default it '0', to turn on set to '1'. This has no effect if
scale divisions are less than 1.
=item scale_divisions()
This defines the gap between markers on the X axis,
default is a 10th of the max_value, e.g. you will have
10 markers on the X axis. NOTE: do not set this too
low - you are limited to 999 markers, after that the
graph won't generate.
=item show_x_title()
Whether to show the title under the X axis labels,
default is 0, set to '1' to show.
=item x_title()
What the title under X axis should be, e.g. 'Months'.
=item show_y_title()
Whether to show the title under the Y axis labels,
default is 0, set to '1' to show.
=item y_title_text_direction()
Aligns writing mode for Y axis label. Defaults to 'bt' (Bottom to Top).
Change to 'tb' (Top to Bottom) to reverse.
=item y_title()
What the title under Y axis should be, e.g. 'Sales in thousands'.
=item show_graph_title()
Whether to show a title on the graph,
default is 0, set to '1' to show.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph,
default is 0, set to '1' to show.
=item graph_subtitle()
What the subtitle on the graph should be.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_position()
Where the key should be positioned, defaults to
'right', set to 'bottom' if you want to move it.
=item x_label_formatter ()
A callback subroutine which will format a label on the x axis. For example:
$graph->x_label_formatter( sub { return '$' . $_[0] } );
=item y_label_formatter()
A callback subroutine which will format a label on the y axis. For example:
$graph->y_label_formatter( sub { return '$' . $_[0] } );
=item show_path_title()
Whether to add the title attribute to the data path tags,
which will show "tooltips" when hovering over the bar area.
=item show_title_fields()
Whether to show field values as title elements in path tag,
defaults to 0, set to '1' to turn on. Suggest on single
add_data graphs, for overlapping graphs leave off to see
the title value used in the add_data call.
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
croak "fields was not supplied or is empty"
unless defined $self->{'config'}->{fields}
&& ref($self->{'config'}->{fields}) eq 'ARRAY'
&& scalar(@{$self->{'config'}->{fields}}) > 0;
}
sub _set_defaults {
my $self = shift;
my %default = (
'width' => '500',
'height' => '300',
'random_colors' => 0,
'style_sheet' => '',
'show_data_values' => 1,
'min_scale_value' => '0',
'scale_divisions' => '',
'bar_gap' => 1,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'x_label_formatter' => sub { return @_ },
'y_label_formatter' => sub { return @_ },
'show_path_title' => 0,
'show_title_fields' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right', # bottom or right
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
1;
__DATA__
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/BarLine.pm 000755 000765 000024 00000075210 12410062063 020056 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::BarLine;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
=head1 NAME
SVG::TT::Graph::BarLine - Create presentation quality SVG bar-line graphs easily
=head1 SYNOPSIS
use SVG::TT::Graph::BarLine;
my @fields = qw(Jan Feb Mar);
my @data_sales_02 = qw(12 45 21);
my @data_sales_03 = (24, 55, 61);
my $graph = SVG::TT::Graph::BarLine->new({
'height' => '500',
'width' => '300',
'fields' => \@fields,
});
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
$graph->add_data({
'data' => \@data_sales_03,
'title' => 'Sales 2003',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG bar graphs. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, data elements at each point,
title, subtitle etc.
=head1 METHODS
=head2 new()
use SVG::TT::Graph::BarLine;
# Field names along the X axis
my @fields = qw(Jan Feb Mar);
my $graph = SVG::TT::Graph::BarLine->new({
# Required
'fields' => \@fields,
# Optional - defaults shown
'height' => '500',
'width' => '300',
'show_data_values' => 1,
'scale_divisions' => '',
'min_scale_value' => '0',
'bar_gap' => 1,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'show_secondary_y_labels' => 1,
'y_label_formatter' => sub { return @_ },
'x_label_formatter' => sub { return @_ },
'show_path_title' => 0,
'show_title_fields' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'show_secondary_y_title' => 0,
'y_title_text_direction' => 'bt',
'secondary_y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'secondary_y_title' => 'Y Scale 2',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right',
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'random_colors' => 0,
});
The constructor takes a hash reference, fields (the names for each
field on the X axis) MUST be set, all other values are defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_sales_02 = qw(12 45 21);
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
This method allows you to add data to the graph object.
It can be called several times to add more data sets in,
but the likelihood is you should be using SVG::TT::Graph::Line
as it won't look great!
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total width
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the defaut internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet
=item show_data_values()
Show the value of each element of data on the graph
=item bar_gap()
Whether to have a gap between the bars or not, default
is '1', set to '0' if you don't want gaps.
=item show_x_labels()
Whether to show labels on the X axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item stagger_x_labels()
This puts the labels at alternative levels so if they
are long field names they will not overlap so easily.
Default it '0', to turn on set to '1'.
=item rotate_x_labels()
This turns the X axis labels by 90 degrees.
Default it '0', to turn on set to '1'.
=item show_y_labels()
Whether to show labels on the Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item scale_integers()
Ensures only whole numbers are used as the scale divisions.
Default it '0', to turn on set to '1'. This has no effect if
scale divisions are less than 1.
=item show_secondary_y_labels()
Whether to show labels on the right hand side Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item min_scale_value()
The point at which the Y axis starts, defaults to '0',
if set to '' it will default to the minimum data value.
=item scale_divisions()
This defines the gap between markers on the Y axis,
default is a 10th of the max_value, e.g. you will have
10 markers on the Y axis. NOTE: do not set this too
low - you are limited to 999 markers, after that the
graph won't generate.
=item show_x_title()
Whether to show the title under the X axis labels,
default is 0, set to '1' to show.
=item x_title()
What the title under X axis should be, e.g. 'Months'.
=item show_y_title()
Whether to show the title on the left hand side Y axis,
default is 0, set to '1' to show.
=item show_secondary_y_title()
Whether to show the title on the right hand side Y axis,
default is 0, set to '1' to show.
=item y_title_text_direction()
Aligns writing mode for Y axis label. Defaults to 'bt' (Bottom to Top).
Change to 'tb' (Top to Bottom) to reverse.
=item secondary_y_title_text_direction()
Aligns writing mode for right hand Y axis label. Defaults to 'bt' (Bottom to Top).
Change to 'tb' (Top to Bottom) to reverse.
=item y_title()
What the title under Y axis should be, e.g. 'Sales in thousands'.
=item secondary_y_title()
What the title on the right hand side Y axis should be, e.g. 'Number of deals'.
=item show_graph_title()
Whether to show a title on the graph, defaults
to 0, set to '1' to show.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph, defaults
to 0, set to '1' to show.
=item graph_subtitle()
What the subtitle on the graph should be.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_position()
Where the key should be positioned, defaults to
'right', set to 'bottom' if you want to move it.
=item x_label_formatter ()
A callback subroutine which will format a label on the x axis. For example:
$graph->x_label_formatter( sub { return '$' . $_[0] } );
=item y_label_formatter()
A callback subroutine which will format a label on the y axis. For example:
$graph->y_label_formatter( sub { return '$' . $_[0] } );
=item show_path_title()
Whether to add the title attribute to the data path tags,
which will show "tooltips" when hovering over the bar area.
=item show_title_fields()
Whether to show field values as title elements in path tag,
defaults to 0, set to '1' to turn on. Suggest on single
add_data graphs, for overlapping graphs leave off to see
the title value used in the add_data call.
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
croak "fields was not supplied or is empty"
unless defined $self->{'config'}->{fields}
&& ref($self->{'config'}->{fields}) eq 'ARRAY'
&& scalar(@{$self->{'config'}->{fields}}) > 0;
}
sub _set_defaults {
my $self = shift;
my %default = (
'width' => '500',
'height' => '300',
'style_sheet' => '',
'random_colors' => 0,
'show_data_values' => 1,
'min_scale_value' => '0',
'scale_divisions' => '',
'bar_gap' => 1,
'show_x_labels' => 1,
'rotate_x_labels' => 0,
'stagger_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'show_secondary_y_labels' => 1,
'x_label_formatter' => sub { return @_ },
'y_label_formatter' => sub { return @_ },
'show_path_title' => 0,
'show_title_fields' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'show_secondary_y_title' => 0,
'y_title_text_direction' => 'bt',
'secondary_y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'secondary_y_title' => 'Y Scale 2',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right', # bottom or right
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
1;
__DATA__
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/Line.pm 000755 000765 000024 00000063100 12410062077 017431 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::Line;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
=head1 NAME
SVG::TT::Graph::Line - Create presentation quality SVG line graphs easily
=head1 SYNOPSIS
use SVG::TT::Graph::Line;
my @fields = qw(Jan Feb Mar);
my @data_sales_02 = qw(12 45 21);
my @data_sales_03 = qw(15 30 40);
my $graph = SVG::TT::Graph::Line->new({
'height' => '500',
'width' => '300',
'fields' => \@fields,
});
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
$graph->add_data({
'data' => \@data_sales_03,
'title' => 'Sales 2003',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG line graphs. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, data elements at each point,
title, subtitle etc.
=head1 METHODS
=head2 new()
use SVG::TT::Graph::Line;
# Field names along the X axis
my @fields = qw(Jan Feb Mar);
my $graph = SVG::TT::Graph::Line->new({
# Required
'fields' => \@fields,
# Optional - defaults shown
'height' => '500',
'width' => '300',
'show_data_points' => 1,
'show_data_values' => 1,
'stacked' => 0,
'min_scale_value' => '0',
'max_scale_value' => undef,
'area_fill' => 0,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'scale_divisions' => '20',
'y_label_formatter' => sub { return @_ },
'x_label_formatter' => sub { return @_ },
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right',
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'random_colors' => 0,
});
The constructor takes a hash reference, fields (the names for each
field on the X axis) MUST be set, all other values are defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_sales_02 = qw(12 45 21);
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
This method allows you to add data to the graph object.
It can be called several times to add more data sets in.
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the defaut internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet
=item show_data_values()
Show the value of each element of data on the graph
=item show_data_points()
Show a small circle on the graph where the line
goes from one point to the next.
=item stacked()
Accumulates each data set. (i.e. Each point increased by
sum of all previous series at same point). Default is 0,
set to '1' to show.
=item min_scale_value()
The point at which the Y axis starts, defaults to '0',
if set to '' it will default to the minimum data value.
=item max_scale_value()
The maximum value for the Y axis. If set to '', it will
default to the maximum data value.
=item show_x_labels()
Whether to show labels on the X axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item show_y_labels()
Whether to show labels on the Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item scale_integers()
Ensures only whole numbers are used as the scale divisions.
Default it '0', to turn on set to '1'. This has no effect if
scale divisions are less than 1.
=item scale_divisions()
This defines the gap between markers on the Y axis,
default is a 10th of the max_value, e.g. you will have
10 markers on the Y axis. NOTE: do not set this too
low - you are limited to 999 markers, after that the
graph won't generate.
=item stagger_x_labels()
This puts the labels at alternative levels so if they
are long field names they will not overlap so easily.
Default it '0', to turn on set to '1'.
=item rotate_x_labels()
This turns the X axis labels by 90 degrees.
Default it '0', to turn on set to '1'.
=item show_x_title()
Whether to show the title under the X axis labels,
default is 0, set to '1' to show.
=item x_title()
What the title under X axis should be, e.g. 'Months'.
=item show_y_title()
Whether to show the title under the Y axis labels,
default is 0, set to '1' to show.
=item y_title_text_direction()
Aligns writing mode for Y axis label. Defaults to 'bt' (Bottom to Top).
Change to 'tb' (Top to Bottom) to reverse.
=item y_title()
What the title under Y axis should be, e.g. 'Sales in thousands'.
=item show_graph_title()
Whether to show a title on the graph,
default is 0, set to '1' to show.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph,
default is 0, set to '1' to show.
=item graph_subtitle()
What the subtitle on the graph should be.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_position()
Where the key should be positioned, defaults to
'right', set to 'bottom' if you want to move it.
=item x_label_formatter ()
A callback subroutine which will format a label on the x axis. For example:
$graph->x_label_formatter( sub { return '$' . $_[0] } );
=item y_label_formatter()
A callback subroutine which will format a label on the y axis. For example:
$graph->y_label_formatter( sub { return '$' . $_[0] } );
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
croak "fields was not supplied or is empty"
unless defined $self->{'config'}->{fields}
&& ref($self->{'config'}->{fields}) eq 'ARRAY'
&& scalar(@{$self->{'config'}->{fields}}) > 0;
}
sub _set_defaults {
my $self = shift;
my %default = (
'width' => '500',
'height' => '300',
'style_sheet' => '',
'random_colors' => 0,
'show_data_points' => 1,
'show_data_values' => 1,
'stacked' => 0,
'min_scale_value' => '0',
'max_scale_value' => '',
'area_fill' => 0,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'show_y_labels' => 1,
'scale_integers' => 0,
'scale_divisions' => '',
'x_label_formatter' => sub { return @_ },
'y_label_formatter' => sub { return @_ },
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title_text_direction' => 'bt',
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right', # bottom or right
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
1;
__DATA__
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/Pie.pm 000755 000765 000024 00000054473 12410062111 017261 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::Pie;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
=head1 NAME
SVG::TT::Graph::Pie - Create presentation quality SVG pie graphs easily
=head1 SYNOPSIS
use SVG::TT::Graph::Pie;
my @fields = qw(Jan Feb Mar);
my @data_sales_02 = qw(12 45 21);
my $graph = SVG::TT::Graph::Pie->new({
'height' => '500',
'width' => '300',
'fields' => \@fields,
});
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG pie graphs. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, display percent on pie chart,
title, subtitle etc.
=head1 METHODS
=head2 new()
use SVG::TT::Graph::Pie;
# Field names along the X axis
my @fields = qw(Jan Feb Mar);
my $graph = SVG::TT::Graph::Pie->new({
# Required
'fields' => \@fields,
# Optional - defaults shown
'height' => '500',
'width' => '300',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'show_shadow' => 1,
'shadow_size' => 1,
'shadow_offset' => 15,
'key_placement' => 'R',
# data by pie chart wedges:
'show_data_labels' => 0,
'show_actual_values' => 0,
'show_percent' => 1,
'rollover_values' => 0,
'show_path_title' => 0,
'show_title_fields' => 0,
# data on key:
'show_key_data_labels' => 1,
'show_key_actual_values' => 1,
'show_key_percent' => 0,
'expanded' => 0,
'expand_greatest' => 0,
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'style_sheet_field_names' => 0,
'random_colors' => 0,
});
The constructor takes a hash reference, fields (the name for each
slice on the pie) MUST be set, all other values are defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_sales_02 = qw(12 45 21);
$graph->add_data({
'data' => \@data_sales_02,
'title' => 'Sales 2002',
});
This method allows you to add data to the graph object, only
the first data set added will be used!
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total width
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the defaut internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet
=item style_sheet_field_names()
If you use the style_sheet_field_names() option then you can
use the field names within your stylesheet. This allows
consistent use of styles. The names should be:
=over 4
=item _dataPoint
=item _key
=back
=item show_graph_title()
Whether to show a title on the graph, default is '0'.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph, default is '0'.
=item graph_subtitle()
What the subtitle on the graph should be.
=item show_shadow()
Turn the shadow on and off, default to '1', set
to '0' if you don't want it. It is automatically
turned off if you extract one section of the pie.
=item shadow_size()
Size of the shadow if shown, measured as
percentage of pie chart radius, default of 1
being the same size as the pie.
=item shadow_offset()
Offset (in pixels) of shadow to bottom-right
in relation to the center of the pie chart.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_placement()
Defaults to 'R' - right, can be
'R', 'L', 'T' or 'B'.
=item show_data_labels()
Show label on pie chart, defaults
to '0', can be set to '1'.
=item show_actual_values()
Show values on pie chart, defaults
to '0', can be set to '1'.
=item show_percent()
Show percent (rounded) on the pie chart, defaults
to '1', can be set to '0'.
=item rollover_values()
Shows data field and value when the mouse is over a piechart wedge.
=item show_path_title()
Whether to add the title attribute to the data path tags,
which will show "tooltips" when hovering over the bar area.
=item show_title_fields()
Whether to show field values as title elements in path tag,
defaults to 0, set to '1' to turn on. Suggest on single
add_data graphs, for overlapping graphs leave off to see
the title value used in the add_data call.
=item show_key_data_labels()
Show label on the key, defaults
to '1', can be set to '0'.
=item show_key_actual_values()
Show value on the key, defaults
to '1', can be set to '0'.
=item show_key_percent()
Show percent (rounded) on the key, defaults
to '0', can be set to '1'.
=item expanded()
All slices of pie are exploded out, defaults
to '0'. Do not set to '1' if you are going to
use expanded_greatest().
=item expand_greatest()
The largest slice of pie is exploded out
from the pie, defaults to '0'. Useful if you are
only showing the percentages (which are rounded) but
still want to visually show which slice was largest.
Do not set to '1' if you are going to
use expanded().
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
croak "fields was not supplied or is empty"
unless defined $self->{'config'}->{fields}
&& ref($self->{'config'}->{fields}) eq 'ARRAY'
&& scalar(@{$self->{'config'}->{fields}}) > 0;
}
sub _set_defaults {
my $self = shift;
my %default = (
'width' => '500',
'height' => '300',
'style_sheet' => '',
'style_sheet_field_names' => 0,
'random_colors' => 0,
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'show_shadow' => 1,
'shadow_size' => 1,
'shadow_offset' => 15,
'key_placement' => 'R',
'show_data_labels' => 0,
'show_actual_values' => 0,
'show_percent' => 1,
'rollover_values' => 0,
'show_path_title' => 0,
'show_title_fields' => 0,
'key' => 0,
'show_key_data_labels' => 1,
'show_key_actual_values' => 1,
'show_key_percent' => 0,
'expanded' => 0,
'expand_greatest' => 0,
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
1;
__DATA__
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/TimeSeries.pm 000755 000765 000024 00000113516 12513273637 020634 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::TimeSeries;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
use Data::Dumper;
use HTTP::Date;
use DateTime;
use POSIX;
=head1 NAME
SVG::TT::Graph::TimeSeries - Create presentation quality SVG line graphs of time series easily
=head1 SYNOPSIS
use SVG::TT::Graph::TimeSeries;
my @data_cpu = ('2003-09-03 09:30:00',23,'2003-09-03 09:45:00',54,'2003-09-03 10:00:00',67,'2003-09-03 10:15:00',12);
my @data_disk = ('2003-09-03 09:00:00',12,'2003-09-03 10:00:00',26,'2003-09-03 11:00:00',23);
my $graph = SVG::TT::Graph::TimeSeries->new({
'height' => '500',
'width' => '300',
});
$graph->add_data({
'data' => \@data_cpu,
'title' => 'CPU',
});
$graph->add_data({
'data' => \@data_disk,
'title' => 'Disk',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG line graphs of time series. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, data elements at each point,
title, subtitle etc.
All times must be given a format parseable by L.
The L module is used for all date/time calculations.
Note that the module is currently limited to the Unix-style epoch-based
date range limited by 32 bit signed integers (around 1902 to 2038).
=head1 METHODS
=head2 new()
use SVG::TT::Graph::TimeSeries;
my $graph = SVG::TT::Graph::TimeSeries->new({
# Optional - defaults shown
'height' => 500,
'width' => 300,
'show_y_labels' => 1,
'scale_divisions' => '',
'min_scale_value' => 0,
'max_scale_value' => '',
'show_x_labels' => 1,
'timescale_divisions' => '',
'min_timescale_value' => '',
'max_timescale_value' => '',
'x_label_format' => '%Y-%m-%d %H:%M:%S',
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'y_label_formatter' => sub { return @_ },
'x_label_formatter' => sub { return @_ },
'show_data_points' => 1,
'show_data_values' => 1,
'rollover_values' => 0,
'area_fill' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right',
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'random_colors' => 0,
});
The constructor takes a hash reference with values defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_cpu = ('2003-09-03 09:30:00',23,'2003-09-03 09:45:00',54,'2003-09-03 10:00:00',67,'2003-09-03 10:15:00',12);
or
my @data_cpu = (['2003-09-03 09:30:00',23],['2003-09-03 09:45:00',54],['2003-09-03 10:00:00',67],['2003-09-03 10:15:00',12]);
or
my @data_cpu = (['2003-09-03 09:30:00',23,'23%'],['2003-09-03 09:45:00',54,'54%'],['2003-09-03 10:00:00',67,'67%'],['2003-09-03 10:15:00',12,'12%']);
$graph->add_data({
'data' => \@data_cpu,
'title' => 'CPU',
});
This method allows you to add data to the graph object. The
data are expected to be either a list of scalars (in which case
pairs of elements are taken to be time, value pairs) or a list
of array references. In the latter case, the first two
elements in each referenced array are taken to be time and
value, and the optional third element (if present) is used as
the text to display for that point for show_data_values and
rollover_values (otherwise the value itself is displayed). It
can be called several times to add more data sets in.
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total width
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the default internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet.
=item show_data_values()
Show the value of each element of data on the graph (or
optionally a user-defined label; see add_data).
=item show_data_points()
Show a small circle on the graph where the line
goes from one point to the next.
=item rollover_values()
Shows data values and data points when the mouse is over the point.
Used in combination with show_data_values and/or show_data_points.
=item data_value_format()
Format specifier to for data values (as per printf).
=item max_time_span()
Maximum timespan for a line between data points. If this span is exceeded, the points are not connected.
This is useful for skipping missing data sections.
The expected form is:
' [years | months | days | hours | minutes | seconds]'
=item stacked()
Accumulates each data set. (i.e. Each point increased by sum of all previous series at same time). Default is 0, set to '1' to show.
All data series have the same number of points and must have the same sequence of time values
for this option.
=item min_scale_value()
The point at which the Y axis starts, defaults to '0',
if set to '' it will default to the minimum data value.
=item max_scale_value()
The point at which the Y axis ends,
if set to '' it will default to the maximum data value.
=item scale_divisions()
This defines the gap between markers on the Y axis,
default is a 10th of the range, e.g. you will have
10 markers on the Y axis. NOTE: do not set this too
low - you are limited to 999 markers, after that the
graph won't generate.
=item show_x_labels()
Whether to show labels on the X axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item x_label_format()
Format string for presenting the X axis labels.
The POSIX strftime() function is used for formatting
(see strftime man pages and LC_TIME locale information).
=item show_y_labels()
Whether to show labels on the Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item y_label_format()
Format string for presenting the Y axis labels (as per printf).
=item timescale_divisions()
This defines the gap between markers on the X axis.
Default is the entire range (only start and end axis
labels).
The expected form is:
' [years | months | days | hours | minutes | seconds]'
The default time period if not provided is 'days'.
These time periods are used by the L methods.
=item timescale_time_zone
This determines the time zone used for the date intervals on the X axis.
Values are those that L accepts for its constructor's 'time_zone'
parameter. The default is 'floating'.
=item stagger_x_labels()
This puts the labels at alternative levels so if they
are long field names they will not overlap so easily.
Default it '0', to turn on set to '1'.
=item rotate_x_labels()
This turns the X axis labels by 90 degrees.
Default it '0', to turn on set to '1'.
=item min_timescale_value()
This sets the minimum timescale value (X axis).
Any data points before this time will not be shown.
The date/time is expected in ISO format: YYYY-MM-DD hh:mm:ss.
=item max_timescale_value()
This sets the maximum timescale value (X axis).
Any data points after this time will not be shown.
The date/time is expected in ISO format: YYYY-MM-DD hh:mm:ss.
=item show_x_title()
Whether to show the title under the X axis labels,
default is 0, set to '1' to show.
=item x_title()
What the title under X axis should be, e.g. 'Months'.
=item show_y_title()
Whether to show the title under the Y axis labels,
default is 0, set to '1' to show.
=item y_title()
What the title under Y axis should be, e.g. 'Sales in thousands'.
=item show_graph_title()
Whether to show a title on the graph,
default is 0, set to '1' to show.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph,
default is 0, set to '1' to show.
=item graph_subtitle()
What the subtitle on the graph should be.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_position()
Where the key should be positioned, defaults to
'right', set to 'bottom' if you want to move it.
=item x_label_formatter ()
A callback subroutine which will format a label on the x axis. For example:
$graph->x_label_formatter( sub { return '$' . $_[0] } );
=item y_label_formatter()
A callback subroutine which will format a label on the y axis. For example:
$graph->y_label_formatter( sub { return '$' . $_[0] } );
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
}
sub _set_defaults {
my $self = shift;
my @fields = ();
my %default = (
'fields' => \@fields,
'width' => '500',
'height' => '300',
'style_sheet' => '',
'random_colors' => 0,
'show_data_points' => 1,
'show_data_values' => 1,
'rollover_values' => 0,
'max_time_span' => '',
'area_fill' => 0,
'show_y_labels' => 1,
'scale_divisions' => '',
'min_scale_value' => '0',
'max_scale_value' => '',
'stacked' => 0,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'timescale_divisions' => '',
'timescale_time_zone' => 'floating',
'x_label_format' => '%Y-%m-%d %H:%M:%S',
'x_label_formatter' => sub { return @_ },
'y_label_formatter' => sub { return @_ },
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right', # bottom or right
'dateadd' => \&dateadd,
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
# override this so we can pre-manipulate the data
sub add_data {
my ($self, $conf) = @_;
croak 'no data provided'
unless (defined $conf->{'data'} && ref($conf->{'data'}) eq 'ARRAY');
# create an array
unless(defined $self->{'data'}) {
my @data;
$self->{'data'} = \@data;
}
# convert to sorted (by ascending time) array of [ time, value ]
my @new_data = ();
my ($i,$time,@pair);
$i = 0;
while ($i < @{$conf->{'data'}}) {
@pair = ();
if (ref($conf->{'data'}->[$i]) eq 'ARRAY') {
push @pair,@{$conf->{'data'}->[$i]};
$i++;
}
else {
$pair[0] = $conf->{'data'}->[$i++];
$pair[1] = $conf->{'data'}->[$i++];
}
$time = str2time($pair[0]);
# special case for time-only values
if ((!defined $time) && ($pair[0] =~ m/^\w*(\d+:\d+:\d+)|(\d+:\d+)\w*$/)) {
$time = str2time('1970-1-1 '.$pair[0]);
}
croak sprintf("Series %d contains an illegal datetime value %s at sample %d.",
scalar(@{$self->{'data'}}),
$pair[0],
$i / 2)
unless (defined $time);
$pair[0] = $time;
push @new_data, [ @pair ];
}
my @sorted = sort {@{$a}[0] <=> @{$b}[0]} @new_data;
# if stacked, we accumulate the
if (($self->{config}->{stacked}) && (@{$self->{'data'}})) {
my $prev = $self->{'data'}->[@{$self->{'data'}} - 1]->{pairs};
# check our length matches previous
croak sprintf("Series %d can not be stacked on previous series. Mismatched length.",
scalar(@{$self->{'data'}}))
unless (scalar(@sorted) == scalar(@$prev));
for (my $i = 0; $i < @sorted; $i++) {
# check the time value matches
croak sprintf("Series %d can not be stacked on previous series. Mismatched timestamp at sample %d (time %s).",
scalar(@{$self->{'data'}}),
$i,
HTTP::Date::time2iso($sorted[$i][0]))
unless ($sorted[$i][0] == $prev->[$i][0]);
$sorted[$i][1] += $prev->[$i][1];
}
}
my %store = (
'pairs' => \@sorted,
);
$store{'title'} = $conf->{'title'} if defined $conf->{'title'};
push (@{$self->{'data'}},\%store);
return 1;
}
#This is for internal use only, so we don't have to pass the time zone around.
#It gets local()ed below before it's used.
our $_TIME_ZONE;
sub burn {
my ($self, @args) = @_;
local $_TIME_ZONE = $self->{'config'}{'timescale_time_zone'};
return $self->SUPER::burn(@args);
}
# Helper function for doing date/time calculations
# Current implementations of DateTime can be slow :-(
sub dateadd {
my ($epoch,$value,$unit) = @_;
my $dt = DateTime->from_epoch(epoch => $epoch);
#This should have been local()ed prior to getting here.
if ( $_TIME_ZONE ) {
$dt->set_time_zone( $_TIME_ZONE );
}
$dt->add( $unit => $value );
return $dt->epoch();
}
# override calculations to set a few calculated values, mainly for scaling
sub calculations {
my $self = shift;
# run through the data and calculate maximum and minimum values
my ($max_key_size,$max_time,$min_time,$max_value,$min_value,$max_x_label_length,$x_label);
foreach my $dataset (@{$self->{data}}) {
$max_key_size = length($dataset->{title}) if ((!defined $max_key_size) || ($max_key_size < length($dataset->{title})));
foreach my $pair (@{$dataset->{pairs}}) {
$max_time = $pair->[0] if ((!defined $max_time) || ($max_time < $pair->[0]));
$min_time = $pair->[0] if ((!defined $min_time) || ($min_time > $pair->[0]));
$max_value = $pair->[1] if (($pair->[1] ne '') && ((!defined $max_value) || ($max_value < $pair->[1])));
$min_value = $pair->[1] if (($pair->[1] ne '') && ((!defined $min_value) || ($min_value > $pair->[1])));
$x_label = strftime($self->{config}->{x_label_format},localtime($pair->[0]));
$max_x_label_length = length($x_label) if ((!defined $max_x_label_length) || ($max_x_label_length < length($x_label)));
}
}
$self->{calc}->{max_key_size} = $max_key_size;
$self->{calc}->{max_time} = $max_time;
$self->{calc}->{min_time} = $min_time;
$self->{calc}->{max_value} = $max_value;
$self->{calc}->{min_value} = $min_value;
$self->{calc}->{max_x_label_length} = $max_x_label_length;
# Calc the x axis scale values
$self->{calc}->{min_timescale_value} = ($self->_is_valid_config('min_timescale_value')) ? str2time($self->{config}->{min_timescale_value}) : $min_time;
$self->{calc}->{max_timescale_value} = ($self->_is_valid_config('max_timescale_value')) ? str2time($self->{config}->{max_timescale_value}) : $max_time;
$self->{calc}->{timescale_range} = $self->{calc}->{max_timescale_value} - $self->{calc}->{min_timescale_value};
# Calc the y axis scale values
$self->{calc}->{min_scale_value} = ($self->_is_valid_config('min_scale_value')) ? $self->{config}->{min_scale_value} : $min_value;
$self->{calc}->{max_scale_value} = ($self->_is_valid_config('max_scale_value')) ? $self->{config}->{max_scale_value} : $max_value;
$self->{calc}->{scale_range} = $self->{calc}->{max_scale_value} - $self->{calc}->{min_scale_value};
my ($range,$division,$precision);
if ($self->_is_valid_config('scale_divisions')) {
$division = $self->{config}->{scale_divisions};
if ($division >= 1) {
$precision = 0;
}
else {
$precision = length($division) - 2;
}
}
else {
# Find divisions, format and range
($range,$division,$precision) = $self->_range_calc($self->{calc}->{scale_range});
# If a max value hasn't been set we can set a revised range and max value
if (! $self->_is_valid_config('max_scale_value')) {
$self->{calc}->{max_scale_value} = $self->{calc}->{min_scale_value} + $range;
$self->{calc}->{scale_range} = $self->{calc}->{max_scale_value} - $self->{calc}->{min_scale_value};
}
}
$self->{calc}->{scale_division} = $division;
$self->{calc}->{y_label_format} = ($self->_is_valid_config('y_label_format')) ? $self->{config}->{y_label_format} : "%.${precision}f";
$self->{calc}->{data_value_format} = ($self->_is_valid_config('data_value_format')) ? $self->{config}->{data_value_format} : "%.${precision}f";
}
1;
__DATA__
[% USE date %]
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/lib/SVG/TT/Graph/XY.pm 000644 000765 000024 00000103330 12410062143 017071 0 ustar 00leo staff 000000 000000 package SVG::TT::Graph::XY;
use strict;
use Carp;
use SVG::TT::Graph;
use base qw(SVG::TT::Graph);
use vars qw($VERSION $TEMPLATE_FH);
$VERSION = $SVG::TT::Graph::VERSION;
$TEMPLATE_FH = \*DATA;
=head1 NAME
SVG::TT::Graph::XY - Create presentation quality SVG line graphs of XY data points easily
=head1 SYNOPSIS
use SVG::TT::Graph::XY;
my @data_cpu = (0.3, 23, 0.5, 54, 1.0, 67, 1.8, 12);
my @data_disk = (0.45, 12, 0.51, 26, 0.53, 23);
my $graph = SVG::TT::Graph::XY->new({
'height' => '500',
'width' => '300',
});
$graph->add_data({
'data' => \@data_cpu,
'title' => 'CPU',
});
$graph->add_data({
'data' => \@data_disk,
'title' => 'Disk',
});
print "Content-type: image/svg+xml\n\n";
print $graph->burn();
=head1 DESCRIPTION
This object aims to allow you to easily create high quality
SVG line graphs of XY data. You can either use the default style sheet
or supply your own. Either way there are many options which can
be configured to give you control over how the graph is
generated - with or without a key, data elements at each point,
title, subtitle etc.
=head1 METHODS
=head2 new()
use SVG::TT::Graph::XY;
my $graph = SVG::TT::Graph::XY->new({
# Optional - defaults shown
'height' => 500,
'width' => 300,
'show_y_labels' => 1,
'yscale_divisions' => '',
'min_yscale_value' => 0,
'max_yscale_value' => '',
'show_x_labels' => 1,
'xscale_divisions' => '',
'min_xscale_value' => '',
'max_xscale_value' => '',
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'y_label_formatter' => sub { return @_ },
'x_label_formatter' => sub { return @_ },
'show_data_points' => 1,
'show_data_values' => 1,
'rollover_values' => 0,
'area_fill' => 0,
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right',
# Stylesheet defaults
'style_sheet' => '/includes/graph.css', # internal stylesheet
'random_colors' => 0,
});
The constructor takes a hash reference with values defaulted to those
shown above - with the exception of style_sheet which defaults
to using the internal style sheet.
=head2 add_data()
my @data_cpu = (0.3, 23, 0.5, 54, 1.0, 67, 1.8, 12);
or
my @data_cpu = ([0.3,23], [0.5,54], [1.0,67], [1.8,12]);
or
my @data_cpu = ([0.3,23,'23%'], [0.5,54,'54%'], [1.0,67,'67%'], [1.8,12,'12%']);
$graph->add_data({
'data' => \@data_cpu,
'title' => 'CPU',
});
This method allows you to add data to the graph object. The
data are expected to be either a list of scalars (in which
case pairs of elements are taken to be X,Y pairs) or a list
of array references. In the latter case, the first two
elements in each referenced array are taken to be X and Y,
and the optional third element (if present) is used as the
text to display for that point for show_data_values and
rollover_values; otherwise the Y value itself is displayed.
It can be called several times to add more data sets in.
=head2 clear_data()
my $graph->clear_data();
This method removes all data from the object so that you can
reuse it to create a new graph but with the same config options.
=head2 burn()
print $graph->burn();
This method processes the template with the data and
config which has been set and returns the resulting SVG.
This method will croak unless at least one data set has
been added to the graph object.
=head2 config methods
my $value = $graph->method();
my $confirmed_new_value = $graph->method($value);
The following is a list of the methods which are available
to change the config of the graph object after it has been
created.
=over 4
=item height()
Set the height of the graph box, this is the total height
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item width()
Set the width of the graph box, this is the total width
of the SVG box created - not the graph it self which auto
scales to fix the space.
=item compress()
Whether or not to compress the content of the SVG file (Compress::Zlib required).
=item tidy()
Whether or not to tidy the content of the SVG file (XML::Tidy required).
=item style_sheet()
Set the path to an external stylesheet, set to '' if
you want to revert back to using the default internal version.
The default stylesheet handles up to 12 data sets. All data series over
the 12th will have no style and be in black. If you have over 12 data
sets you can assign them all random colors (see the random_color()
method) or create your own stylesheet and add the additional settings
for the extra data sets.
To create an external stylesheet create a graph using the
default internal version and copy the stylesheet section to
an external file and edit from there.
=item random_colors()
Use random colors in the internal stylesheet.
=item show_data_values()
Show the value of each element of data on the graph (or
optionally a user-defined label; see add_data).
=item show_data_points()
Show a small circle on the graph where the line
goes from one point to the next.
=item rollover_values()
Shows data values and data points when the mouse is over the point.
Used in combination with show_data_values and/or show_data_points.
=item data_value_format()
Format specifier to for data values (as per printf).
=item max_x_span()
Maximum span for a line between data points on the X-axis. If this span is
exceeded, the points are not connected. This is useful for skipping missing data
sections. If you set this value to something smaller than 0 (e.g. -1), you will
get an XY scatter plot with no line joining the data points.
=item stacked()
Accumulates each data set. (i.e. Each point increased by
sum of all previous series at same point). Default is 0,
set to '1' to show.
=item min_yscale_value()
The point at which the Y axis starts, defaults to '0',
if set to '' it will default to the minimum data value.
=item max_yscale_value()
The point at which the Y axis ends,
if set to '' it will default to the maximum data value.
=item yscale_divisions()
This defines the gap between markers on the Y axis,
default is a 10th of the range, e.g. you will have
10 markers on the Y axis. NOTE: do not set this too
low - you are limited to 999 markers, after that the
graph won't generate.
=item show_x_labels()
Whether to show labels on the X axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item show_y_labels()
Whether to show labels on the Y axis or not, defaults
to 1, set to '0' if you want to turn them off.
=item y_label_format()
Format string for presenting the Y axis labels (as per printf).
=item xscale_divisions()
This defines the gap between markers on the X axis.
Default is the entire range (only start and end axis
labels).
=item stagger_x_labels()
This puts the labels at alternative levels so if they
are long field names they will not overlap so easily.
Default it '0', to turn on set to '1'.
=item rotate_x_labels()
This turns the X axis labels by 90 degrees.
Default it '0', to turn on set to '1'.
=item min_xscale_value()
This sets the minimum X value. Any data points before this value will not be
shown.
=item max_xscale_value()
This sets the maximum X value. Any data points after this value will not be
shown.
=item show_x_title()
Whether to show the title under the X axis labels,
default is 0, set to '1' to show.
=item x_title()
What the title under X axis should be, e.g. 'Parameter X'.
=item show_y_title()
Whether to show the title under the Y axis labels,
default is 0, set to '1' to show.
=item y_title()
What the title under Y axis should be, e.g. 'Sales in thousands'.
=item show_graph_title()
Whether to show a title on the graph,
default is 0, set to '1' to show.
=item graph_title()
What the title on the graph should be.
=item show_graph_subtitle()
Whether to show a subtitle on the graph,
default is 0, set to '1' to show.
=item graph_subtitle()
What the subtitle on the graph should be.
=item key()
Whether to show a key, defaults to 0, set to
'1' if you want to show it.
=item key_position()
Where the key should be positioned, defaults to
'right', set to 'bottom' if you want to move it.
=item x_label_formatter ()
A callback subroutine which will format a label on the x axis. For example:
$graph->x_label_formatter( sub { return '$' . $_[0] } );
=item y_label_formatter()
A callback subroutine which will format a label on the y axis. For example:
$graph->y_label_formatter( sub { return '$' . $_[0] } );
=back
=head1 EXAMPLES
For examples look at the project home page
http://leo.cuckoo.org/projects/SVG-TT-Graph/
=head1 EXPORT
None by default.
=head1 SEE ALSO
L,
L,
L,
L,
L,
L,
L,
L
=cut
sub _init {
my $self = shift;
}
sub _set_defaults {
my $self = shift;
my @fields = ();
my %default = (
'fields' => \@fields,
'width' => '500',
'height' => '300',
'style_sheet' => '',
'random_colors' => 0,
'show_data_points' => 1,
'show_data_values' => 1,
'rollover_values' => 0,
'max_x_span' => '',
'area_fill' => 0,
'show_y_labels' => 1,
'yscale_divisions' => '',
'min_yscale_value' => '0',
'stacked' => 0,
'show_x_labels' => 1,
'stagger_x_labels' => 0,
'rotate_x_labels' => 0,
'xscale_divisions' => '',
'x_label_formatter' => sub { return @_ },
'y_label_formatter' => sub { return @_ },
'show_x_title' => 0,
'x_title' => 'X Field names',
'show_y_title' => 0,
'y_title' => 'Y Scale',
'show_graph_title' => 0,
'graph_title' => 'Graph Title',
'show_graph_subtitle' => 0,
'graph_subtitle' => 'Graph Sub Title',
'key' => 0,
'key_position' => 'right', # bottom or right
);
while( my ($key,$value) = each %default ) {
$self->{config}->{$key} = $value;
}
}
# override this so we can pre-manipulate the data
sub add_data {
my ($self, $conf) = @_;
croak 'no data provided'
unless (defined $conf->{'data'} && ref($conf->{'data'}) eq 'ARRAY');
# create an array
unless(defined $self->{'data'}) {
my @data;
$self->{'data'} = \@data;
}
# convert to sorted (by ascending numeric value) array of [ x, y ]
my @new_data = ();
my ($i,$x,@pair);
$i = 0;
while ($i < @{$conf->{'data'}}) {
@pair = ();
if (ref($conf->{'data'}->[$i]) eq 'ARRAY') {
push @pair,@{$conf->{'data'}->[$i]};
$i++;
}
else {
$pair[0] = $conf->{'data'}->[$i++];
$pair[1] = $conf->{'data'}->[$i++];
}
push @new_data, [ @pair ];
}
my @sorted = sort {@{$a}[0] <=> @{$b}[0]} @new_data;
# if stacked, we accumulate the
if (($self->{config}->{stacked}) && (@{$self->{'data'}})) {
my $prev = $self->{'data'}->[@{$self->{'data'}} - 1]->{pairs};
# check our length matches previous
croak sprintf("Series %d can not be stacked on previous series. Mismatched length.",
scalar(@{$self->{'data'}}))
unless (scalar(@sorted) == scalar(@$prev));
for (my $i = 0; $i < @sorted; $i++) {
# check the x value matches
croak sprintf("Series %d can not be stacked on previous series. Mismatched x value at sample %d (x %s).",
scalar(@{$self->{'data'}}),
$i,
$sorted[$i][0])
unless ($sorted[$i][0] == $prev->[$i][0]);
$sorted[$i][1] += $prev->[$i][1];
}
}
my %store = (
'pairs' => \@sorted,
);
$store{'title'} = $conf->{'title'} if defined $conf->{'title'};
push (@{$self->{'data'}},\%store);
return 1;
}
# override calculations to set a few calculated values, mainly for scaling
sub calculations {
my $self = shift;
# run through the data and calculate maximum and minimum values
my ($max_key_size, $max_x, $min_x, $max_y, $min_y, $max_x_label_length, $x_label);
foreach my $dataset (@{$self->{data}}) {
$max_key_size = length($dataset->{title}) if ((!defined $max_key_size) || ($max_key_size < length($dataset->{title})));
foreach my $pair (@{$dataset->{pairs}}) {
$max_x = $pair->[0] if ((!defined $max_x) || ($max_x < $pair->[0]));
$min_x = $pair->[0] if ((!defined $min_x) || ($min_x > $pair->[0]));
$max_y = $pair->[1] if (($pair->[1] ne '') && ((!defined $max_y) || ($max_y < $pair->[1])));
$min_y = $pair->[1] if (($pair->[1] ne '') && ((!defined $min_y) || ($min_y > $pair->[1])));
$x_label = $pair->[0];
$max_x_label_length = length($x_label) if ((!defined $max_x_label_length) || ($max_x_label_length < length($x_label)));
}
}
$self->{calc}->{max_key_size} = $max_key_size;
$self->{calc}->{max_x} = $max_x;
$self->{calc}->{min_x} = $min_x;
$self->{calc}->{max_y} = $max_y;
$self->{calc}->{min_y} = $min_y;
$self->{calc}->{max_x_label_length} = $max_x_label_length;
# Calc the x axis scale values
$self->{calc}->{min_xscale_value} = ($self->_is_valid_config('min_xscale_value')) ? $self->{config}->{min_xscale_value} : $min_x;
$self->{calc}->{max_xscale_value} = ($self->_is_valid_config('max_xscale_value')) ? $self->{config}->{max_xscale_value} : $max_x;
$self->{calc}->{xscale_range} = $self->{calc}->{max_xscale_value} - $self->{calc}->{min_xscale_value};
# Calc the y axis scale values
$self->{calc}->{min_yscale_value} = ($self->_is_valid_config('min_yscale_value')) ? $self->{config}->{min_yscale_value} : $min_y;
$self->{calc}->{max_yscale_value} = ($self->_is_valid_config('max_yscale_value')) ? $self->{config}->{max_yscale_value} : $max_y;
$self->{calc}->{yscale_range} = $self->{calc}->{max_yscale_value} - $self->{calc}->{min_yscale_value};
my ($range,$division,$precision);
if ($self->_is_valid_config('yscale_divisions')) {
$division = $self->{config}->{yscale_divisions};
if ($division >= 1) {
$precision = 0;
}
else {
$precision = length($division) - 2;
}
}
else {
# Find divisions, format and range
($range, $division, $precision) = $self->_range_calc($self->{calc}->{yscale_range});
# If a max value hasn't been set we can set a revised range and max value
if (! $self->_is_valid_config('max_yscale_value')) {
$self->{calc}->{max_yscale_value} = $self->{calc}->{min_yscale_value} + $range;
$self->{calc}->{yscale_range} = $self->{calc}->{max_yscale_value} - $self->{calc}->{min_yscale_value};
}
}
$self->{calc}->{yscale_division} = $division;
$self->{calc}->{y_label_format} = ($self->_is_valid_config('y_label_format')) ? $self->{config}->{y_label_format} : "%.${precision}f";
$self->{calc}->{data_value_format} = ($self->_is_valid_config('data_value_format')) ? $self->{config}->{data_value_format} : "%.${precision}f";
}
1;
__DATA__
[% stylesheet = 'included' %]
[% IF config.style_sheet && config.style_sheet != '' %]
[% ELSE %]
[% stylesheet = 'excluded' %]
[% END %]
SVG-TT-Graph-0.25/inc/Module/ 000755 000765 000024 00000000000 12513274446 015413 5 ustar 00leo staff 000000 000000 SVG-TT-Graph-0.25/inc/Module/Install/ 000755 000765 000024 00000000000 12513274446 017021 5 ustar 00leo staff 000000 000000 SVG-TT-Graph-0.25/inc/Module/Install.pm 000644 000765 000024 00000030133 12513274426 017355 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.12';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
END_DIE
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
It was impossible to maintain duel backends, and has been deprecated.
Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
#-------------------------------------------------------------
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
#-------------------------------------------------------------
unless ( -f $self->{file} ) {
foreach my $key (keys %INC) {
delete $INC{$key} if $key =~ /Module\/Install/;
}
local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
local $^W;
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{'inc/Module/Install.pm'};
delete $INC{'Module/Install.pm'};
# Save to the singleton
$MAIN = $self;
return 1;
}
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
unless ($$sym =~ s/([^:]+)$//) {
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
return;
} elsif ( $method =~ /^_/ and $self->can($method) ) {
# Dispatch to the root M:I class
return $self->$method(@_);
}
# Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
goto &{$self->can('call')};
};
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
}
my @exts = @{$self->{extensions}};
unless ( @exts ) {
@exts = $self->{admin}->load_all_extensions;
}
my %seen;
foreach my $obj ( @exts ) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless $obj->can($method);
next if $method =~ /^_/;
next if $method eq uc($method);
$seen{$method}++;
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
delete $INC{'FindBin.pm'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
require FindBin;
}
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
$args{bundle} ||= 'inc/BUNDLES';
$args{base} ||= $base_path;
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ( $args{path} ) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
$should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} =
$should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
next if /^\s*#/; # and comments
if ( m/^\s*package\s+($pkg)\s*;/i ) {
$pkg = $1;
last;
}
}
}
push @found, [ $file, $pkg ];
}, $path ) if -d $path;
@found;
}
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; };
close FH or die "close($_[0]): $!";
return $string;
}
END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
my $string = do { local $/; };
close FH or die "close($_[0]): $!";
return $string;
}
END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
return $string;
}
sub _readpod {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
return $string if $_[0] =~ /\.pod\z/;
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
sub _CLASS {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
SVG-TT-Graph-0.25/inc/Module/Install/Base.pm 000644 000765 000024 00000002147 12513274426 020233 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.12';
}
# Suspend handler for "redefined" warnings
BEGIN {
my $w = $SIG{__WARN__};
$SIG{__WARN__} = sub { $w };
}
#line 42
sub new {
my $class = shift;
unless ( defined &{"${class}::call"} ) {
*{"${class}::call"} = sub { shift->_top->call(@_) };
}
unless ( defined &{"${class}::load"} ) {
*{"${class}::load"} = sub { shift->_top->load(@_) };
}
bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
local $@;
my $func = eval { shift->_top->autoload } or return;
goto &$func;
}
#line 75
sub _top {
$_[0]->{_top};
}
#line 90
sub admin {
$_[0]->_top->{admin}
or
Module::Install::Base::FakeAdmin->new;
}
#line 106
sub is_admin {
! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
use vars qw{$VERSION};
BEGIN {
$VERSION = $Module::Install::Base::VERSION;
}
my $fake;
sub new {
$fake ||= bless(\@_, $_[0]);
}
sub AUTOLOAD {}
sub DESTROY {}
# Restore warning handler
BEGIN {
$SIG{__WARN__} = $SIG{__WARN__}->();
}
1;
#line 159
SVG-TT-Graph-0.25/inc/Module/Install/Can.pm 000644 000765 000024 00000006157 12513274426 020067 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Can;
use strict;
use Config ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;
my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;
local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
require File::Spec;
my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# Can our C compiler environment build XS files
sub can_xs {
my $self = shift;
# Ensure we have the CBuilder module
$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
# Do we have the configure_requires checker?
local $@;
eval "require ExtUtils::CBuilder;";
if ( $@ ) {
# They don't obey configure_requires, so it is
# someone old and delicate. Try to avoid hurting
# them by falling back to an older simpler test.
return $self->can_cc();
}
# Do we have a working C compiler
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
unless ( $builder->have_compiler ) {
# No working C compiler
return 0;
}
# Write a C file representative of what XS becomes
require File::Temp;
my ( $FH, $tmpfile ) = File::Temp::tempfile(
"compilexs-XXXXX",
SUFFIX => '.c',
);
binmode $FH;
print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int main(int argc, char **argv) {
return 0;
}
int boot_sanexs() {
return 1;
}
END_C
close $FH;
# Can the C compiler access the same headers XS does
my @libs = ();
my $object = undef;
eval {
local $^W = 0;
$object = $builder->compile(
source => $tmpfile,
);
@libs = $builder->link(
objects => $object,
module_name => 'sanexs',
);
};
my $result = $@ ? 0 : 1;
# Clean up all the build files
foreach ( $tmpfile, $object, @libs ) {
next unless defined $_;
1 while unlink;
}
return $result;
}
# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}
1;
__END__
#line 236
SVG-TT-Graph-0.25/inc/Module/Install/Fetch.pm 000644 000765 000024 00000004627 12513274426 020417 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
SVG-TT-Graph-0.25/inc/Module/Install/Makefile.pm 000644 000765 000024 00000027437 12513274426 021107 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing or non-interactive session, always use defaults
if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array
# or a hash or something else (which may or may not be appendable).
my %makemaker_argtype = (
C => 'ARRAY',
CONFIG => 'ARRAY',
# CONFIGURE => 'CODE', # ignore
DIR => 'ARRAY',
DL_FUNCS => 'HASH',
DL_VARS => 'ARRAY',
EXCLUDE_EXT => 'ARRAY',
EXE_FILES => 'ARRAY',
FUNCLIST => 'ARRAY',
H => 'ARRAY',
IMPORTS => 'HASH',
INCLUDE_EXT => 'ARRAY',
LIBS => 'ARRAY', # ignore ''
MAN1PODS => 'HASH',
MAN3PODS => 'HASH',
META_ADD => 'HASH',
META_MERGE => 'HASH',
PL_FILES => 'HASH',
PM => 'HASH',
PMLIBDIRS => 'ARRAY',
PMLIBPARENTDIRS => 'ARRAY',
PREREQ_PM => 'HASH',
CONFIGURE_REQUIRES => 'HASH',
SKIP => 'ARRAY',
TYPEMAPS => 'ARRAY',
XS => 'HASH',
# VERSION => ['version',''], # ignore
# _KEEP_AFTER_FLUSH => '',
clean => 'HASH',
depend => 'HASH',
dist => 'HASH',
dynamic_lib=> 'HASH',
linkext => 'HASH',
macro => 'HASH',
postamble => 'HASH',
realclean => 'HASH',
test => 'HASH',
tool_autosplit => 'HASH',
# special cases where you can use makemaker_append
CCFLAGS => 'APPENDABLE',
DEFINE => 'APPENDABLE',
INC => 'APPENDABLE',
LDDLFLAGS => 'APPENDABLE',
LDFROM => 'APPENDABLE',
);
sub makemaker_args {
my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
foreach my $key (keys %new_args) {
if ($makemaker_argtype{$key}) {
if ($makemaker_argtype{$key} eq 'ARRAY') {
$args->{$key} = [] unless defined $args->{$key};
unless (ref $args->{$key} eq 'ARRAY') {
$args->{$key} = [$args->{$key}]
}
push @{$args->{$key}},
ref $new_args{$key} eq 'ARRAY'
? @{$new_args{$key}}
: $new_args{$key};
}
elsif ($makemaker_argtype{$key} eq 'HASH') {
$args->{$key} = {} unless defined $args->{$key};
foreach my $skey (keys %{ $new_args{$key} }) {
$args->{$key}{$skey} = $new_args{$key}{$skey};
}
}
elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
$self->makemaker_append($key => $new_args{$key});
}
}
else {
if (defined $args->{$key}) {
warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
}
$args->{$key} = $new_args{$key};
}
}
return $args;
}
# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{$name} = defined $args->{$name}
? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
sub build_subdirs {
my $self = shift;
my $subdirs = $self->makemaker_args->{DIR} ||= [];
for my $subdir (@_) {
push @$subdirs, $subdir;
}
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
sub _wanted_t {
}
sub tests_recursive {
my $self = shift;
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
File::Find::find(
sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
$dir
);
$self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Check the current Perl version
my $perl_version = $self->perl_version;
if ( $perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
# Make sure we have a new enough MakeMaker
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
# This previous attempted to inherit the version of
# ExtUtils::MakeMaker in use by the module author, but this
# was found to be untenable as some authors build releases
# using future dev versions of EU:MM that nobody else has.
# Instead, #toolchain suggests we use 6.59 which is the most
# stable version on CPAN at time of writing and is, to quote
# ribasushi, "not terminally fucked, > and tested enough".
# TODO: We will now need to maintain this over time to push
# the version up as new versions are released.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{NAME} =~ s/-/::/g;
$args->{VERSION} = $self->version or die <<'EOT';
ERROR: Can't determine distribution version. Please specify it
explicitly via 'version' in Makefile.PL, or set a valid $VERSION
in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
$args->{test} = {
TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( $Module::Install::ExtraTests::use_extratests ) {
# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
# So, just ignore our xt tests here.
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
};
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
#$args->{NO_MYMETA} = 1;
}
if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
if ( $self->makemaker(6.31) and $self->license ) {
$args->{LICENSE} = $self->license;
}
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# Merge both kinds of requires into BUILD_REQUIRES
my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
%$build_prereq = ( %$build_prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires)
);
# Remove any reference to perl, BUILD_REQUIRES doesn't support it
delete $args->{BUILD_REQUIRES}->{perl};
# Delete bundled dists from prereq_pm, add it to Makefile DIR
my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
my %processed;
foreach my $bundle (@{ $self->bundles }) {
my ($mod_name, $dist_dir) = @$bundle;
delete $prereq->{$mod_name};
$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
if (not exists $processed{$dist_dir}) {
if (-d $dist_dir) {
# List as sub-directory to be processed by make
push @$subdirs, $dist_dir;
}
# Else do nothing: the module is already present on the system
$processed{$dist_dir} = undef;
}
}
}
unless ( $self->makemaker('6.55_03') ) {
%$prereq = (%$prereq,%$build_prereq);
delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
if ( $self->makemaker(6.48) ) {
$args->{MIN_PERL_VERSION} = $perl_version;
}
}
if ($self->installdirs) {
warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
$args->{INSTALLDIRS} = $self->installdirs;
}
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
sub fix_up_makefile {
my $self = shift;
my $makefile_name = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; };
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
seek MAKEFILE, 0, SEEK_SET;
truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 544
SVG-TT-Graph-0.25/inc/Module/Install/Metadata.pm 000644 000765 000024 00000043302 12513274426 021077 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
};
my @scalar_keys = qw{
name
module_name
abstract
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
};
my @resource_keys = qw{
homepage
bugtracker
repository
};
my @array_keys = qw{
keywords
author
};
*authors = \&author;
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
sub Meta_ArrayKeys { @array_keys }
foreach my $key ( @boolean_keys ) {
*$key = sub {
my $self = shift;
if ( defined wantarray and not @_ ) {
return $self->{values}->{$key};
}
$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
return $self;
};
}
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} = shift;
return $self;
};
}
foreach my $key ( @array_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} ||= [];
push @{$self->{values}->{$key}}, @_;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}->{resources} };
}
return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
}
foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
my $value = shift or next;
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}->{resources} ||= [];
push @{ $self->{values}->{resources} }, [ $name, $value ];
}
$self->{values}->{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
my $value = @_ ? shift : 1;
if ( $self->{values}->{dynamic_config} ) {
# Once dynamic we never change to static, for safety
return 0;
}
$self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
# Convenience command
sub static_config {
shift->dynamic_config(0);
}
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
# Normalize the version
$version = $self->_perl_version($version);
# We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
$self->{values}->{perl_version} = $version;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
$self->{values}{all_from} = $file;
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
$pod =~ s/\.pm$/.pod/i;
$pod = $file unless -e $pod;
# Pull the different values
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
$self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
return 1;
}
sub provides {
my $self = shift;
my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
sub auto_provides {
my $self = shift;
return $self unless $self->is_admin;
unless (-e 'MANIFEST') {
warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
return $self;
}
# Avoid spurious warnings as we are not checking manifest here.
local $SIG{__WARN__} = sub {1};
require ExtUtils::Manifest;
local *ExtUtils::Manifest::manicheck = sub { return };
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->name,
dist_version => $self->version,
license => $self->license,
);
$self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
my $self = shift;
my $name = shift;
my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}->{features}
? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
return $self->{values}->{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
}
sub write {
my $self = shift;
return $self unless $self->is_admin;
$self->admin->write_meta;
return $self;
}
sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
# for version integrity check
$self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->abstract(
bless(
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
);
}
# Add both distribution and module name
sub name_from {
my ($self, $file) = @_;
if (
Module::Install::_read($file) =~ m/
^ \s*
package \s*
([\w:]+)
[\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
$name =~ s{::}{-}g;
$self->name($name);
unless ( $self->module_name ) {
$self->module_name($module_name);
}
} else {
die("Cannot determine name from $file\n");
}
}
sub _extract_perl_version {
if (
$_[0] =~ m/
^\s*
(?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
return $perl_version;
} else {
return;
}
}
sub perl_version_from {
my $self = shift;
my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
([^\n]*)
/ixms) {
my $author = $1 || $2;
# XXX: ugly but should work anyway...
if (eval "require Pod::Escapes; 1") {
# Pod::Escapes has a mapping table.
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E}{<}g;
$author =~ s{E}{>}g;
}
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
#Stolen from M::B
my %license_urls = (
perl => 'http://dev.perl.org/licenses/',
apache => 'http://apache.org/licenses/LICENSE-2.0',
apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
artistic => 'http://opensource.org/licenses/artistic-license.php',
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$license = __extract_license($license) || lc $license;
$self->{values}->{license} = $license;
# Automatically fill in license URLs
if ( $license_urls{$license} ) {
$self->resources( license => $license_urls{$license} );
}
return 1;
}
sub _extract_license {
my $pod = shift;
my $matched;
return __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
(=head \d.*|=cut.*|)\z
/xms
) || __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
(=head \d.*|=cut.*|)\z
/xms
);
}
sub __extract_license {
my $license_text = shift or return;
my @phrases = (
'(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
'Artistic and GPL' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
'GNU lesser public license' => 'lgpl', 1,
'GNU library general public license' => 'lgpl', 1,
'GNU library public license' => 'lgpl', 1,
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
'Artistic license 2\.0' => 'artistic_2', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
'BSD' => 'bsd', 1,
'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
'Mozilla Public License' => 'mozilla', 1,
'Q Public License' => 'open_source', 1,
'OpenSSL License' => 'unrestricted', 1,
'SSLeay License' => 'unrestricted', 1,
'zlib License' => 'open_source', 1,
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
return $license;
}
}
return '';
}
sub license_from {
my $self = shift;
if (my $license=_extract_license(Module::Install::_read($_[0]))) {
$self->license($license);
} else {
warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
}
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
https?\Q://rt.cpan.org/\E[^>]+|
https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
@links=keys %links;
return @links;
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->requires( $module => $version );
}
}
sub test_requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
######################################################################
# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
sub write_mymeta_yaml {
my $self = shift;
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
if ( $perl >= 5.006 ) {
$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
}
unshift @$requires, [ perl => $perl ];
}
# Load the advisory META.yml file
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
return $meta;
}
1;
SVG-TT-Graph-0.25/inc/Module/Install/Win32.pm 000644 000765 000024 00000003403 12513274426 020257 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
);
die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
Since you are using Microsoft Windows, you will need the 'nmake' utility
before installation. It's available at:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
or
ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
Please download the file manually, save it to a directory in %PATH% (e.g.
C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
that directory, and run "Nmake15.exe" from there; that will create the
'nmake.exe' file needed by this module.
You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
}
1;
SVG-TT-Graph-0.25/inc/Module/Install/WriteAll.pm 000644 000765 000024 00000002376 12513274426 021110 0 ustar 00leo staff 000000 000000 #line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.12';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
sub WriteAll {
my $self = shift;
my %args = (
meta => 1,
sign => 0,
inline => 0,
check_nmake => 1,
@_,
);
$self->sign(1) if $args{sign};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
# XXX: This still may be a bit over-defensive...
unless ($self->makemaker(6.25)) {
$self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
}
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
# we clean it up properly ourself.
$self->realclean_files('MYMETA.yml');
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
if ( $args{meta} ) {
$self->Meta->write;
}
# Experimental support for MYMETA
if ( $ENV{X_MYMETA} ) {
if ( $ENV{X_MYMETA} eq 'JSON' ) {
$self->Meta->write_mymeta_json;
} else {
$self->Meta->write_mymeta_yaml;
}
}
return 1;
}
1;