/usr/share/perl5/Chart/Gnuplot/Util.pm is in libchart-gnuplot-perl 0.17-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | package Chart::Gnuplot::Util;
use strict;
use vars qw(@ISA @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(_lineType _pointType _borderCode _copy);
# Convert named line type to indexed line type of gnuplot
#
# XXX
# Assuming postscript terminal is used
# This may subjected to change when postscript/gnuplot changes its convention
sub _lineType
{
my ($type) = @_;
return($type) if ($type =~ /^\d+$/);
# Indexed line type of postscript terminal of gnuplot
my %type = (
solid => 1,
longdash => 2,
dash => 3,
dot => 4,
'dot-longdash' => 5,
'dot-dash' => 6,
'2dash' => 7,
'2dot-dash' => 8,
'4dash' => 9,
);
return($type{$type});
}
# Convert named line type to indexed line type of gnuplot
#
# XXX
# Assuming postscript terminal is used
# This may subjected to change when postscript/gnuplot changes its convention
sub _pointType
{
my ($type) = @_;
return($type) if ($type =~ /^\d+$/);
# Indexed line type of postscript terminal of gnuplot
my %type = (
dot => 0,
plus => 1,
cross => 2,
star => 3,
'dot-square' => 4,
'dot-circle' => 6,
'dot-triangle' => 8,
'dot-diamond' => 12,
'dot-pentagon' => 14,
'fill-square' => 5,
'fill-circle' => 7,
'fill-triangle' => 9,
'fill-diamond' => 13,
'fill-pentagon' => 15,
square => 64,
circle => 65,
triangle => 66,
diamond => 68,
pentagon => 69,
'opaque-square' => 70,
'opaque-circle' => 71,
'opaque-triangle' => 72,
'opaque-diamond' => 74,
'opaque-pentagon' => 75,
);
return($type{$type});
}
# Encode the border name
# - Used by setting graph border display
sub _borderCode
{
my ($side) = @_;
return($side) if ($side =~ /^\d+$/);
my $code = 0;
$code += 1 if ($side =~ /(^|,)\s*(1|bottom|bottom left front)\s*(,|$)/);
$code += 2 if ($side =~ /(^|,)\s*(2|left|bottom left back)\s*(,|$)/);
$code += 4 if ($side =~ /(^|,)\s*(4|top|bottom right front)\s*(,|$)/);
$code += 8 if ($side =~ /(^|,)\s*(8|right|bottom right back)\s*(,|$)/);
$code += 16 if ($side =~ /(^|,)\s*(16|left vertical)\s*(,|$)/);
$code += 32 if ($side =~ /(^|,)\s*(32|back vertical)\s*(,|$)/);
$code += 64 if ($side =~ /(^|,)\s*(64|right vertical)\s*(,|$)/);
$code += 128 if ($side =~ /(^|,)\s*(128|front vertical)\s*(,|$)/);
$code += 256 if ($side =~ /(^|,)\s*(256|top left back)\s*(,|$)/);
$code += 512 if ($side =~ /(^|,)\s*(512|top right back)\s*(,|$)/);
$code += 1024 if ($side =~ /(^|,)\s*(1024|top left front)\s*(,|$)/);
$code += 2048 if ($side =~ /(^|,)\s*(2048|top right front)\s*(,|$)/);
return($code);
}
# Copy object using dclone() of Storable
sub _copy
{
my ($obj, $num) = @_;
use Storable;
my @clones = ();
$num = 1 if (!defined $num);
for (my $i = 0; $i < $num; $i++)
{
push(@clones, Storable::dclone($obj));
}
return(@clones);
}
1;
__END__
|