File Coverage

/.cpan/build/Data-Reporter-1.4-7q98YS/blib/lib/Data/Reporter/RepFormat.pm
Criterion Covered Total %
statement 41 54 75.9
branch 7 18 38.8
condition n/a
subroutine 7 9 77.7
pod n/a
total 55 81 67.9


line stmt bran cond sub pod time code
1             package RepFormatPtr;
2 1     1   5 use strict;
  1         2  
  1         33  
3 1     1   5 use Carp;
  1         2  
  1         454  
4             sub Printf($$@) {
5 1     1   3 my ($self, $format, @args) = @_;
6 1         4 my $str = sprintf($format, @args);
7 1         5 Print($self, $str);
8             }
9              
10             sub Commify($$) {
11 1     1   3 my ($self, $str) = @_;
12              
13 1 50       12 return "" unless(defined($str));
14 1 50       9 croak "Incorrect format ($str) to put commas"
15             if ($str !~ /([+-]{0,1})(\d+)(\.{0,1})(\d*)/);
16 1         2 my $sign = "";
17 1 50       7 $sign = $1 if (defined($1));
18 1         3 my $integerpart = $2;
19 1         3 my $decimalpart = "";
20 1 50       4 $decimalpart = "\.$4" if ($4 ne "");
21 1         2 my $size = length($str);
22              
23 1         3 $integerpart = reverse $integerpart;
24 1         2 $str = "";
25 1         4 while ($integerpart ne "") {
26 2 100       5 if (length($integerpart) > 3) {
27 1         3 $str .= substr($integerpart, 0, 3);
28 1         24 $str .= ",";
29 1         4 substr($integerpart, 0, 3) = "";
30             } else {
31 1         3 $str .= substr($integerpart, 0, length($integerpart));
32 1         3 $integerpart = "";
33             }
34             }
35              
36 1         3 $str = $sign . (reverse $str) . $decimalpart;
37 1         2 my $espaces = "";
38 1 50       3 $espaces = " " x ($size - length($str)) if ($size >= length($str));
39 1         2 $str = $espaces . $str;
40 1         3 return $str;
41             }
42              
43             sub MVPrintf($$$$@) {
44 0     0     my ($self, $x, $y, $format, @args) = @_;
45 0           Move($self, $x, $y);
46 0           Printf($self, $format, @args);
47             }
48              
49             package Data::Reporter::RepFormat;
50              
51 1     1   5 use strict;
  1         2  
  1         30  
52 1     1   4 use Carp;
  1         2  
  1         44  
53 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
  1         1  
  1         339  
54              
55             require Exporter;
56             require DynaLoader;
57             require AutoLoader;
58              
59             @ISA = qw(Exporter DynaLoader);
60             # Items to export into callers namespace by default. Note: do not export
61             # names by default without a very good reason. Use EXPORT_OK instead.
62             # Do not simply export all your public functions/methods/constants.
63             @EXPORT = qw(
64             FORMAT_HEADER
65             );
66             $VERSION = '0.01';
67              
68             sub AUTOLOAD {
69             # This AUTOLOAD is used to 'autoload' constants from the constant()
70             # XS function. If a constant is not found then control is passed
71             # to the AUTOLOAD in AutoLoader.
72              
73 0     0     my $constname;
74 0           ($constname = $AUTOLOAD) =~ s/.*:://;
75 0 0         my $val = constant($constname, @_ ? $_[0] : 0);
76 0 0         if ($! != 0) {
77 0 0         if ($! =~ /Invalid/) {
78 0           $AutoLoader::AUTOLOAD = $AUTOLOAD;
79 0           goto &AutoLoader::AUTOLOAD;
80             }
81             else {
82 0           croak "Your vendor has not defined RepFormat macro $constname";
83             }
84             }
85 0           eval "sub $AUTOLOAD { $val }";
86 0           goto &$AUTOLOAD;
87             }
88              
89             bootstrap Data::Reporter::RepFormat $VERSION;
90              
91             # Preloaded methods go here.
92              
93             # Autoload methods go after =cut, and are processed by the autosplit program.
94              
95             1;
96              
97             __END__