File Coverage

blib/lib/HTML/HashTable.pm
Criterion Covered Total %
statement 60 67 89.5
branch 13 16 81.2
condition 3 4 75.0
subroutine 10 10 100.0
pod 0 9 0.0
total 86 106 81.1


\n"; \n"; \n";
line stmt bran cond sub pod time code
1              
2             # Items to export into callers namespace by default. Note: do not export
3             # names by default without a very good reason. Use EXPORT_OK instead.
4             # Do not simply export all your public functions/methods/constants.
5              
6             # This allows declaration use HTML::HashTable ':all';
7             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
8             # will save memory.
9              
10              
11             $VERSION = $VERSION = 0.60;
12              
13             require 5.005;
14              
15             package HTML::HashTable;
16              
17             require Exporter;
18             @ISA = qw( Exporter );
19             @EXPORT = qw(tablify);
20              
21 1     1   26765 use strict;
  1         3  
  1         864  
22              
23             =head1 NAME
24              
25             C - Create an HTML table from a Perl hash
26              
27             =head1 SYNOPSIS
28              
29             use HTML::HashTable;
30             print tablify({
31             BORDER => 0,
32             DATA => $myhashref,
33             SORTBY => 'key',
34             ORDER => 'desc'}
35             );
36              
37             =head1 DESCRIPTION
38              
39             This module takes an arbitrary Perl hash and presents it as an HTML
40             table. The hash can contain anything you want -- scalar data,
41             arrayrefs, hashrefs, whatever. Yes, this means you can use a tied
42             hash if you wish.
43              
44             The HTML produced is nicely formatted and indented, suitable for
45             human editing and manipulation.
46              
47             Some options are provided with the tablify() function to allow you
48             to specify whether you wish to have a border or not, and whether you
49             wish your table to be sorted by key or value (but note that sorting
50             by value gives almost meaningless results if your values are
51             references, as in a deeply nested Perl data structure.)
52              
53             The options given to the tablify() function are:
54              
55             =item C
56              
57             True or false depending on whether you want your table to have a
58             border. Defaults to true (1).
59              
60             =item C
61              
62             Reference to your hash
63              
64             =item C
65              
66             Either 'key' or 'value' depending on how you want your data sorted.
67             Note that sorting by value is more or less meaningless if your
68             values are references (as in a deeply nested data structure). Defaults
69             to "key".
70              
71             =item C
72              
73             Either 'asc' or 'desc' depending on whether you want your sorting to
74             be in ascending or descending order. Defaults to "asc".
75              
76             =cut
77              
78             sub tablify {
79 5     5 0 639 $HTML::HashTable::output = '';
80 5         7 $HTML::HashTable::depth = 0;
81 5         5 my $tsref = shift;
82 5   50     29 $tsref->{SORTBY} ||= "key";
83 5   100     17 $tsref->{ORDER} ||= "asc";
84 5 100       15 $tsref->{BORDER} = 1 unless (defined $tsref->{BORDER});
85 5         12 make_table($tsref);
86 5         34 return $HTML::HashTable::output;
87             }
88              
89             #
90             # This subroutine does most of the work by recursing through the
91             # hash supplied. We look to see whether the value of any hash
92             # item is a scalar, an arrayref or a hashref, and act accordingly.
93             # Recursion's so rare in Perl... this is *fun*
94             #
95              
96             sub recurse_through {
97 55     55 0 56 my $tsref = shift;
98 55         55 my $thingy = shift;
99 55 100       123 if (ref($thingy) eq 'ARRAY') {
    100          
100 10         14 foreach (@$thingy) {
101 30         41 recurse_through($tsref, $_);
102             }
103             } elsif (ref($thingy) eq 'HASH') {
104 5         21 my $newref = {%$tsref};
105 5         12 $newref->{DATA} = $thingy;
106 5         9 open_cell();
107 5         9 make_table($newref);
108 5         8 close_cell($HTML::HashTable::depth);
109             } else { # plain old scalar data
110 40         55 open_cell();
111 40         46 $HTML::HashTable::output .= $thingy;
112 40         60 close_cell(0);
113             }
114             }
115              
116             sub open_table {
117 10     10 0 11 my $tsref = shift;
118 10         15 $HTML::HashTable::output .= "\n";
119 10         12 $HTML::HashTable::output .= "\t" x $HTML::HashTable::depth;
120 10 100       29 $HTML::HashTable::output .= $tsref->{BORDER} ? "\n" : "
\n";
121             }
122              
123             sub close_table {
124 10     10 0 14 $HTML::HashTable::output .= "\t" x $HTML::HashTable::depth;
125 10         12 $HTML::HashTable::output .= "
\n";
126             }
127              
128             sub open_row {
129 25     25 0 31 $HTML::HashTable::output .= "\t" x ($HTML::HashTable::depth);
130 25         25 $HTML::HashTable::output .= "
131 25         28 $HTML::HashTable::depth++;
132             }
133              
134             sub close_row {
135 25     25 0 24 $HTML::HashTable::depth--;
136 25         28 $HTML::HashTable::output .= "\t" x ($HTML::HashTable::depth);
137 25         43 $HTML::HashTable::output .= "
138             }
139              
140             sub open_cell {
141 70     70 0 86 $HTML::HashTable::output .= "\t" x ($HTML::HashTable::depth);
142 70         68 $HTML::HashTable::output .= "";
143 70         73 $HTML::HashTable::depth++;
144             }
145              
146             sub close_cell {
147 70     70 0 70 my $d = shift;
148 70 100       117 $d-- if $d;
149 70         79 $HTML::HashTable::output .= "\t" x ($d);
150 70         64 $HTML::HashTable::output .= "
151 70         125 $HTML::HashTable::depth--;
152             }
153            
154             sub make_table {
155 10     10 0 11 my $tsref = shift;
156 10         15 open_table($tsref);
157 10         11 foreach my $key (sort {
158 20 50       41 if ($tsref->{SORTBY} eq "value") {
  10         39  
159 0 0       0 if ($tsref->{ORDER} eq 'asc') {
160 0         0 ${$tsref->{DATA}}{$a} cmp ${$tsref->{DATA}}{$b};
  0         0  
  0         0  
161             } else {
162 0         0 ${$tsref->{DATA}}{$b} cmp ${$tsref->{DATA}}{$a};
  0         0  
  0         0  
163             }
164             } else {
165 20 100       37 if ($tsref->{ORDER} eq 'asc') {
166 16         34 $a cmp $b;
167             } else {
168 4         10 $b cmp $a;
169             }
170             }
171             } keys %{$tsref->{DATA}}) {
172 25         37 open_row;
173 25         38 open_cell;
174 25         23 $HTML::HashTable::output .= $key;
175 25         38 close_cell(0);
176 25         23 recurse_through($tsref, ${$tsref->{DATA}}{$key});
  25         62  
177 25         41 close_row;
178             }
179 10         44 close_table;
180             }
181              
182              
183              
184              
185             =head1 AUTHOR
186              
187             Kirrily "Skud" Robert
188              
189             =head1 SEE ALSO
190              
191             L.
192              
193             =cut