File Coverage

blib/lib/Data/Hash/Totals.pm
Criterion Covered Total %
statement 29 29 100.0
branch 7 8 87.5
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 42 43 97.6


line stmt bran cond sub pod time code
1             package Data::Hash::Totals;
2              
3 3     3   66353 use warnings;
  3         5  
  3         85  
4 3     3   16 use strict;
  3         5  
  3         173  
5              
6             =head1 NAME
7              
8             Data::Hash::Totals - Handle hashes that are totals or counts
9              
10             =head1 VERSION
11              
12             Version 0.10
13              
14             =cut
15              
16             our $VERSION = '0.10';
17              
18             =head1 SYNOPSIS
19              
20             This module is so butt simple, but I'm tired of redoing this code over and over again.
21              
22             my %fave_stooge_votes = (
23             Moe => 31,
24             Larry => 15,
25             Curly => 97,
26             Shemp => 3,
27             );
28              
29             print as_table( \%fave_stooge_votes );
30              
31             prints the following:
32              
33             97 Curly
34             31 Moe
35             15 Larry
36             3 Shemp
37              
38             =cut
39              
40 3     3   17 use Exporter;
  3         16  
  3         1352  
41             our @ISA = qw( Exporter );
42             our @EXPORT = qw( as_table );
43             our @EXPORT_OK = qw( as_table );
44              
45             =head1 EXPORTS
46              
47             Exports C.
48              
49             =head1 FUNCTIONS
50              
51             =head2 as_table( $hashref [, key1 => value1 ] )
52              
53             Prints the contents of I<$hashref> as a table in descending value
54             order.
55              
56             I/I pairs modify the output style. Currently, all
57             that's supported is C<< comma => 1 >> to insert commas in the
58             numbers.
59              
60             =cut
61              
62             sub as_table {
63 2     2 1 28 my $hash = shift;
64 2         6 my %parms = @_;
65              
66 2         3 my %display_values;
67 2         5 my $longest = 0;
68 2         7 for my $key ( keys %$hash ) {
69 8         13 my $disp = $hash->{$key};
70 8 100       24 $disp = _commify( $disp ) if $parms{comma};
71 8         12 $display_values{ $key } = $disp;
72 8 100       22 $longest = length( $disp ) if length( $disp ) > $longest;
73             }
74 2         7 for my $disp ( values %display_values ) {
75 8         11 my $diff = $longest - length($disp);
76 8 100       32 $disp = (" " x $diff) . $disp if $diff;
77             }
78              
79 9 50       34 my @keys = sort {
80 2         13 $hash->{$b} <=> $hash->{$a} # Values descending
81             or $a cmp $b # Keys ascending
82             } keys %$hash;
83 2         5 my @lines = map { sprintf( "%s %s\n", $display_values{$_}, $_ ) } @keys;
  8         28  
84              
85 2         12 return @lines;
86             }
87              
88             sub _commify {
89 4     4   7 my $text = reverse $_[0];
90 4         19 $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
91 4         9 return scalar reverse $text;
92             }
93              
94             =head1 AUTHOR
95              
96             Andy Lester, C<< >>
97              
98             =head1 BUGS
99              
100             Please report any bugs or feature requests to
101             C, or through the web interface at
102             L. I will be notified, and then you'll automatically
103             be notified of progress on your bug as I make changes.
104              
105             =head1 ACKNOWLEDGEMENTS
106              
107             =head1 COPYRIGHT & LICENSE
108              
109             Copyright 2004 Andy Lester, All Rights Reserved.
110              
111             This program is free software; you can redistribute it and/or modify it
112             under the same terms as Perl itself.
113              
114             =cut
115              
116             1; # End of Data::Hash::Totals