File: | C4/Utils.pm |
Coverage: | 42.6% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package C4::Utils; | |||||
2 | ||||||
3 | # Useful code I didn't feel like duplicating all over the place. | |||||
4 | # | |||||
5 | ||||||
6 | 2 2 2 | 539 2 44 | use strict; | |||
7 | 2 2 2 | 9 3 119 | use warnings; | |||
8 | 2 2 2 | 10 2 312 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); | |||
9 | ||||||
10 | BEGIN { | |||||
11 | 2 | 10 | require Exporter; | |||
12 | 2 | 2 | $VERSION = 1.00; # set the version for version checking | |||
13 | 2 | 51 | $debug = $ENV{DEBUG} || 0; | |||
14 | 2 | 21 | @ISA = qw(Exporter); | |||
15 | 2 | 27 | @EXPORT_OK = qw(&maxwidth &hashdump); | |||
16 | 2 | 721 | %EXPORT_TAGS = ( all => [qw(&maxwidth &hashdump)], ); | |||
17 | } | |||||
18 | ||||||
19 | ||||||
20 | sub maxwidth (@) { | |||||
21 | 0 | (@_) or return 0; | ||||
22 | 0 0 0 | return (sort {$a <=> $b} map {length} @_)[-1]; | ||||
23 | } | |||||
24 | ||||||
25 | sub hashdump ($$) { | |||||
26 | 0 | my $pre = shift; | ||||
27 | 0 | my $val = shift; | ||||
28 | 0 | if (ref($val) =~ /HASH/) { | ||||
29 | 0 | print "$pre = HASH w/ " . scalar(keys %$val) . " keys.\n"; | ||||
30 | 0 | my $w2 = maxwidth(keys %$val); | ||||
31 | 0 | foreach (sort keys %$val) { | ||||
32 | 0 | &hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $val->{$_}); | ||||
33 | } | |||||
34 | 0 | print "\n"; | ||||
35 | } elsif (ref($val) =~ /ARRAY/) { | |||||
36 | 0 | print "$pre = ARRAY w/ " . scalar(@$val) . " members.\n"; | ||||
37 | 0 | my $w2 = maxwidth(@$val); | ||||
38 | 0 | foreach (@$val) { | ||||
39 | 0 | &hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $_); | ||||
40 | } | |||||
41 | 0 | print "\n"; | ||||
42 | } else { | |||||
43 | 0 | print "$pre = $val\n"; | ||||
44 | } | |||||
45 | } | |||||
46 | ||||||
47 | 1; |