|
65
|
|
|
|
|
|
|
atr_table - attribute parameters for
|
66
|
|
|
|
|
|
|
css_tr - CSS class name for |
|
67
|
|
|
|
|
|
|
atr_tr - attribute parameters for |
|
68
|
|
|
|
|
|
|
atr_tr_odd - attribute parameters for ODD |
|
69
|
|
|
|
|
|
|
atr_tr_even - attribute parameters for EVEN |
|
70
|
|
|
|
|
|
|
css_tr_odd - CSS class name for ODD |
|
71
|
|
|
|
|
|
|
css_tr_even - CSS class name for EVEN |
|
72
|
|
|
|
|
|
|
css_select - CSS class name for |
|
73
|
|
|
|
|
|
|
css_input - CSS class name for |
|
74
|
|
|
|
|
|
|
atr_sel - attributes for itemized |
|
75
|
|
|
|
|
|
|
atr_sel = { |
|
76
|
|
|
|
|
|
|
var1 => 'style="display:none"', |
|
77
|
|
|
|
|
|
|
var2 => 'style="display:block"', |
|
78
|
|
|
|
|
|
|
var3 => 'class="FormSel"', |
|
79
|
|
|
|
|
|
|
} |
|
80
|
|
|
|
|
|
|
atr_inp - attributes for itemized |
|
81
|
|
|
|
|
|
|
css_td - CSS class name for | |
|
82
|
|
|
|
|
|
|
atr_td - attribute parameters for | |
|
83
|
|
|
|
|
|
|
atr_cell - an array ref to attribute parameters for each cell |
|
84
|
|
|
|
|
|
|
${$br}{atr_cell}[$i][$j] |
|
85
|
|
|
|
|
|
|
esc_vars - a list of escaped variables separated by comma. |
|
86
|
|
|
|
|
|
|
fh_out - output file handler |
|
87
|
|
|
|
|
|
|
cns_desc - hash ref containing column name description |
|
88
|
|
|
|
|
|
|
tab_caption - table caption/header |
|
89
|
|
|
|
|
|
|
tab_footer - table footer/notes |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Variables used or methods called: |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
CGI::AppBuilder::Message |
|
94
|
|
|
|
|
|
|
set_param - get parameter from a hash |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
How to use: |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my @a = (['ColA','ColB'],[1,2],[5,6],[7,8]); |
|
100
|
|
|
|
|
|
|
my $txt = $self->html_table(\@a); |
|
101
|
|
|
|
|
|
|
my @b = ({A=>1,B=>2},{A=>5,B=>6},{A=>7,B=>8}); |
|
102
|
|
|
|
|
|
|
my $txt = $self->html_table(\@b,"",'A,B'); |
|
103
|
|
|
|
|
|
|
my $txt = $self->html_table(\@b,"",'A,B'); |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Return: generates HTML Table codes. |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
This method convert all the < and > into < and > for displaying, |
|
108
|
|
|
|
|
|
|
except variables are specified in I. |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub html_table { |
|
113
|
|
|
|
|
|
|
my $s = shift; |
|
114
|
|
|
|
|
|
|
my($ar,$cns,$br) = @_; |
|
115
|
|
|
|
|
|
|
return "No Input for html_table!\n" if !$ar; |
|
116
|
|
|
|
|
|
|
return "Not a Array for html_table\n" if $ar !~ /ARRAY/; |
|
117
|
|
|
|
|
|
|
my ($cn_lst, $cr) = ("",[]); |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
if (${$ar}[0] =~ /HASH/) { |
|
120
|
|
|
|
|
|
|
if (!$cns || $cns =~ /^(auto|hash|AH)$/i) { |
|
121
|
|
|
|
|
|
|
map { $cn_lst .= "$_," } (keys %{$ar->[0]}); |
|
122
|
|
|
|
|
|
|
$cn_lst =~ s/,$//; $cn_lst = lc $cn_lst; |
|
123
|
|
|
|
|
|
|
} else { $cn_lst = $cns; } |
|
124
|
|
|
|
|
|
|
$cn_lst =~ s/\s+//g; |
|
125
|
|
|
|
|
|
|
$cr = $ar; |
|
126
|
|
|
|
|
|
|
} else { # it is an array |
|
127
|
|
|
|
|
|
|
if (!$cns || $cns =~ /^(auto|hash|AH)$/i) { |
|
128
|
|
|
|
|
|
|
map { $cn_lst .= "$ar->[0][$_]," } 0..$#{$ar->[0]}; |
|
129
|
|
|
|
|
|
|
$cn_lst =~ s/,$//; $cn_lst = lc $cn_lst; |
|
130
|
|
|
|
|
|
|
} else { $cn_lst = $cns; } |
|
131
|
|
|
|
|
|
|
$cn_lst =~ s/\s+//g; |
|
132
|
|
|
|
|
|
|
my @a = split /,/, $cn_lst; |
|
133
|
|
|
|
|
|
|
shift @$ar; # remove the first row |
|
134
|
|
|
|
|
|
|
$cr = [map{my %tmp;@tmp{@a}=@$_;\%tmp}@$ar]; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
return "No column names are provided or defined.\n" |
|
137
|
|
|
|
|
|
|
if !$cn_lst; |
|
138
|
|
|
|
|
|
|
my $css_table = $s->set_param('css_table', $br); |
|
139
|
|
|
|
|
|
|
my $atr_table = $s->set_param('atr_table', $br); |
|
140
|
|
|
|
|
|
|
my $css_tr = $s->set_param('css_tr', $br); |
|
141
|
|
|
|
|
|
|
my $atr_tr = $s->set_param('atr_tr', $br); |
|
142
|
|
|
|
|
|
|
my $atr_tr_od = $s->set_param('atr_tr_odd', $br); |
|
143
|
|
|
|
|
|
|
my $atr_tr_ev = $s->set_param('atr_tr_even', $br); |
|
144
|
|
|
|
|
|
|
my $css_tr_od = $s->set_param('css_tr_odd', $br); |
|
145
|
|
|
|
|
|
|
my $css_tr_ev = $s->set_param('css_tr_even', $br); |
|
146
|
|
|
|
|
|
|
my $ar_sel = eval $s->set_param('atr_sel', $br); |
|
147
|
|
|
|
|
|
|
my $ar_inp = eval $s->set_param('atr_inp', $br); |
|
148
|
|
|
|
|
|
|
my $css_select= $s->set_param('css_select', $br); |
|
149
|
|
|
|
|
|
|
my $css_input = $s->set_param('css_input', $br); |
|
150
|
|
|
|
|
|
|
my $css_td = $s->set_param('css_td', $br); |
|
151
|
|
|
|
|
|
|
my $atr_td = $s->set_param('atr_td', $br); |
|
152
|
|
|
|
|
|
|
my $atr_cell = $s->set_param('atr_cell', $br); |
|
153
|
|
|
|
|
|
|
$atr_cell = eval $atr_cell if $atr_cell; |
|
154
|
|
|
|
|
|
|
$atr_cell = [] if ! $atr_cell; |
|
155
|
|
|
|
|
|
|
my $pretty = $s->set_param('tab_pretty', $br); |
|
156
|
|
|
|
|
|
|
my $cap = $s->set_param('tab_caption', $br); |
|
157
|
|
|
|
|
|
|
my $ftr = $s->set_param('tab_footer', $br); |
|
158
|
|
|
|
|
|
|
my $esc_vars = $s->set_param('esc_vars', $br); |
|
159
|
|
|
|
|
|
|
my $esc = ($esc_vars) ? { |
|
160
|
|
|
|
|
|
|
map { $_ => 1 } (split /,/,$esc_vars) |
|
161
|
|
|
|
|
|
|
} : {}; |
|
162
|
|
|
|
|
|
|
# my $tr = $s->html_tag('TR', |
|
163
|
|
|
|
|
|
|
# {class=>$css_tr,attr=>$atr_tr,pretty=>$pretty}); |
|
164
|
|
|
|
|
|
|
my $t = $s->html_tag('TABLE', |
|
165
|
|
|
|
|
|
|
{class=>$css_table,attr=>$atr_table,pretty=>$pretty}); |
|
166
|
|
|
|
|
|
|
$t .= $s->html_tag('CAPTION',{},$cap,1) if $cap; |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
my ($i,$j,$k,$v); |
|
169
|
|
|
|
|
|
|
# add column names |
|
170
|
|
|
|
|
|
|
my $dsc = (exists $br->{cns_desc}) ? $br->{cns_desc} : {}; |
|
171
|
|
|
|
|
|
|
# map { $_ => {name=>ucfirst $_, desc=>ucfirst $_} } |
|
172
|
|
|
|
|
|
|
# (split /,/, $cn_lst) |
|
173
|
|
|
|
|
|
|
# add column header |
|
174
|
|
|
|
|
|
|
$t .= $s->table_column($cn_lst,$br,$dsc); |
|
175
|
|
|
|
|
|
|
# add data rows |
|
176
|
|
|
|
|
|
|
my $p = {class=>$css_td,attr=>$atr_td,pretty=>$pretty,hr=>{}}; |
|
177
|
|
|
|
|
|
|
my $p_tr = {pretty=>$pretty,hr=>{}}; |
|
178
|
|
|
|
|
|
|
for $i (0 .. $#{$cr}) { |
|
179
|
|
|
|
|
|
|
if ($i%2) { # odd |
|
180
|
|
|
|
|
|
|
$p_tr->{class} = ($css_tr_od) ? $css_tr_od : $css_tr; |
|
181
|
|
|
|
|
|
|
$p_tr->{attr} = ($atr_tr_od) ? $atr_tr_od : $atr_tr; |
|
182
|
|
|
|
|
|
|
} else { # even |
|
183
|
|
|
|
|
|
|
$p_tr->{class} = ($css_tr_ev) ? $css_tr_ev : $css_tr; |
|
184
|
|
|
|
|
|
|
$p_tr->{attr} = ($atr_tr_ev) ? $atr_tr_ev : $atr_tr; |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
$t .= $s->html_tag('TR',$p_tr); |
|
187
|
|
|
|
|
|
|
$j = -1; |
|
188
|
|
|
|
|
|
|
foreach my $k (split /,/,$cn_lst) { |
|
189
|
|
|
|
|
|
|
++$j; |
|
190
|
|
|
|
|
|
|
$v = $cr->[$i]{$k}; |
|
191
|
|
|
|
|
|
|
if ($v && $v =~ /type=["']?input["']?/si) { |
|
192
|
|
|
|
|
|
|
$v =~ s/\<\s*input/\
|
|
193
|
|
|
|
|
|
|
if $css_input; |
|
194
|
|
|
|
|
|
|
$v =~ s/\<\s*input/\{$k} /i |
|
195
|
|
|
|
|
|
|
if exists $ar_inp->{$k}; |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
if ($v && $v =~ /\<\s*select/si) { |
|
198
|
|
|
|
|
|
|
$v =~ s/\<\s*select/\ |
|
199
|
|
|
|
|
|
|
if $css_select; |
|
200
|
|
|
|
|
|
|
$v =~ s/\<\s*select/\ |
|
201
|
|
|
|
|
|
|
if exists $ar_sel->{$k}; |
|
202
|
|
|
|
|
|
|
} |
|
203
|
|
|
|
|
|
|
if (! exists $esc->{$k}) { |
|
204
|
|
|
|
|
|
|
$v =~ s/
|
|
205
|
|
|
|
|
|
|
$v =~ s/>/\>/g if $v; |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
$v = "" if ! defined($v) || $v =~ /^\s*$/; |
|
208
|
|
|
|
|
|
|
$p->{attr} = ($atr_cell->[$i][$j]) ? |
|
209
|
|
|
|
|
|
|
"$atr_td $atr_cell->[$i][$j]" : $atr_td; |
|
210
|
|
|
|
|
|
|
$t .= $s->html_tag('TD',$p,"$v",1); |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
$t .= " | \n";
|
213
|
|
|
|
|
|
|
} |
|
214
|
|
|
|
|
|
|
$t .= " | \n"; |
|
215
|
|
|
|
|
|
|
if ($ftr) { |
|
216
|
|
|
|
|
|
|
$t .= $s->html_tag('CENTER',{},$s->html_tag('P',{},$ftr,1),1); |
|
217
|
|
|
|
|
|
|
} |
|
218
|
|
|
|
|
|
|
my $fh = ($br && exists $br->{fh_out})?$br->{fh_out}:""; |
|
219
|
|
|
|
|
|
|
if ($fh) { print $fh $t; } else { return $t; } |
|
220
|
|
|
|
|
|
|
} |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 html_tag ($tag, $pr, $txt, $is_end) |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Input variables: |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
$tag - HTML tag such as TR, TD, TABLE, SELECT, INPUT, etc. |
|
227
|
|
|
|
|
|
|
$pr - tag attribute array ref. It contains three elements: |
|
228
|
|
|
|
|
|
|
class - CSS class name |
|
229
|
|
|
|
|
|
|
attr - attribute string such as 'width=5 onChange=js_func' |
|
230
|
|
|
|
|
|
|
hr - hash ref with key and value pairs |
|
231
|
|
|
|
|
|
|
pretty - whether to add line breaks |
|
232
|
|
|
|
|
|
|
$txt - text to be incuded between the start and end tag such as |
|
233
|
|
|
|
|
|
|
| $txt |
|
234
|
|
|
|
|
|
|
$is_end - whether to add an ending tag such as |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Variables used or methods called: |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
None |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
How to use: |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
my $t1 = $self->html_tag('TD',{class=>'css_td'},'Text',1); |
|
243
|
|
|
|
|
|
|
# $t1 contains: |
|
244
|
|
|
|
|
|
|
# | Text |
|
245
|
|
|
|
|
|
|
my $t2 = $self->html_tag('TD',{class=>'td1',pretty=>1},'Text2',1); |
|
246
|
|
|
|
|
|
|
# $t2 contains: |
|
247
|
|
|
|
|
|
|
# | |
|
248
|
|
|
|
|
|
|
# Text2 |
|
249
|
|
|
|
|
|
|
# |
|
250
|
|
|
|
|
|
|
my $t3 = $self->html_tag('TD',{class=>'td1',pretty=>1, |
|
251
|
|
|
|
|
|
|
attr=>'colspan=2 align=left',hr=>{onChange=>'js_func'}}, |
|
252
|
|
|
|
|
|
|
'Text2',1); |
|
253
|
|
|
|
|
|
|
# $t3 contains: |
|
254
|
|
|
|
|
|
|
# | |
|
255
|
|
|
|
|
|
|
# Text2 |
|
256
|
|
|
|
|
|
|
# |
|
257
|
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Return: HTML codes. |
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
This method generates HTML codes based on the information provided. |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=cut |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub html_tag { |
|
265
|
|
|
|
|
|
|
my $s = shift; |
|
266
|
|
|
|
|
|
|
my ($tag, $pr, $txt, $is_end) = @_; |
|
267
|
|
|
|
|
|
|
$tag = uc $tag; |
|
268
|
|
|
|
|
|
|
my $tg = lc $tag; |
|
269
|
|
|
|
|
|
|
my $idt = {tr=>2,td=>4,li=>2,th=>4}; |
|
270
|
|
|
|
|
|
|
my $t = (exists $idt->{$tg}) ? ' 'x$idt->{$tg} : ""; |
|
271
|
|
|
|
|
|
|
$t .= "<$tag"; |
|
272
|
|
|
|
|
|
|
$t .= " class=$pr->{class}" |
|
273
|
|
|
|
|
|
|
if $pr && exists $pr->{class} && $pr->{class}; |
|
274
|
|
|
|
|
|
|
$t .= " $pr->{attr}" |
|
275
|
|
|
|
|
|
|
if $pr && exists $pr->{attr} && $pr->{attr}; |
|
276
|
|
|
|
|
|
|
if ($pr && exists $pr->{hr} && ref($pr->{hr}) eq 'HASH') { |
|
277
|
|
|
|
|
|
|
map { $t .= " $_='$pr->{hr}{$_}'" } (keys %{$pr->{hr}}); |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
$t .= ">"; |
|
280
|
|
|
|
|
|
|
if ($pr && exists $pr->{pretty} && $pr->{pretty} && |
|
281
|
|
|
|
|
|
|
$tg !~ /^(td|li)/ ) { |
|
282
|
|
|
|
|
|
|
$t .= "\n"; |
|
283
|
|
|
|
|
|
|
$t .= " $txt\n" if defined($txt) && $txt !~ /^\s*$/; |
|
284
|
|
|
|
|
|
|
$t .= (exists $idt->{$tg}) ? ' 'x$idt->{$tg} : ""; |
|
285
|
|
|
|
|
|
|
} else { |
|
286
|
|
|
|
|
|
|
$t .= (defined($txt) && $txt !~ /^\s*$/) ? $txt : |
|
287
|
|
|
|
|
|
|
(($tg =~ /^td/i) ? ' ' : ""); |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
$t .= "\n" if $is_end; |
|
290
|
|
|
|
|
|
|
return $t; |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head2 table_column ($cn,$pr,$cr) |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
Input variables: |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$cn - column names separated by comma, or |
|
298
|
|
|
|
|
|
|
array ref containing column names , or |
|
299
|
|
|
|
|
|
|
hash ref containing column names as keys |
|
300
|
|
|
|
|
|
|
$pr - tag attribute array ref. It contains the following items: |
|
301
|
|
|
|
|
|
|
css_tr - TR class name |
|
302
|
|
|
|
|
|
|
atr_tr - TR attributes |
|
303
|
|
|
|
|
|
|
css_td - TD class name |
|
304
|
|
|
|
|
|
|
atr_td - TD attributes |
|
305
|
|
|
|
|
|
|
pretty - whether to add line breaks |
|
306
|
|
|
|
|
|
|
atr_cell - Cell attribute |
|
307
|
|
|
|
|
|
|
$cr - column description hash ref $cr->{$k}{$itm} |
|
308
|
|
|
|
|
|
|
where $k is column name and the items ($itm) are : |
|
309
|
|
|
|
|
|
|
desc - column description |
|
310
|
|
|
|
|
|
|
name - display name |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
Variables used or methods called: |
|
313
|
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
html_tag - generate HTML tags |
|
315
|
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
How to use: |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
my $cn = 'seq,fn,ln'; |
|
319
|
|
|
|
|
|
|
my $pr = {css_tr=>'tr_pretty',css_td=>'td_small',pretty=>1}; |
|
320
|
|
|
|
|
|
|
my $cr = {seq=>{name=>'Seq No',desc=>'Sequential number'}, |
|
321
|
|
|
|
|
|
|
fn =>{name=>'First Name',desc=>'First name'}, |
|
322
|
|
|
|
|
|
|
ln =>{name=>'Last Name',desc=>'Last name/family name'}, |
|
323
|
|
|
|
|
|
|
}; |
|
324
|
|
|
|
|
|
|
my $t = $self->table_column($cn,$pr,$cr); |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
Return: HTML codes. |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
This method generates HTML codes for table header row (TH) |
|
329
|
|
|
|
|
|
|
based on the information provided. |
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=cut |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub table_column { |
|
334
|
|
|
|
|
|
|
my $s = shift; |
|
335
|
|
|
|
|
|
|
my ($cn,$pr,$cr) = @_; |
|
336
|
|
|
|
|
|
|
carp "No column names are specified." if !$cn; |
|
337
|
|
|
|
|
|
|
return if !$cn; |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
my $cns = $cn; |
|
340
|
|
|
|
|
|
|
if (ref($cn) =~ /ARRAY/) { |
|
341
|
|
|
|
|
|
|
$cns = ""; map { $cns .= "$_," } @$cn; $cns =~ s/,$//; |
|
342
|
|
|
|
|
|
|
} elsif (ref($cn) =~ /HASH/) { |
|
343
|
|
|
|
|
|
|
$cns = ""; map { $cns .= "$_," } keys %$cn; $cns =~ s/,$//; |
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
carp "No column names are specified." if !$cns; |
|
346
|
|
|
|
|
|
|
return if !$cns; |
|
347
|
|
|
|
|
|
|
my $css_tr = $s->set_param('css_tr', $pr); |
|
348
|
|
|
|
|
|
|
my $atr_tr = $s->set_param('atr_tr', $pr); |
|
349
|
|
|
|
|
|
|
my $css_td = $s->set_param('css_td', $pr); |
|
350
|
|
|
|
|
|
|
my $atr_td = $s->set_param('atr_td', $pr); |
|
351
|
|
|
|
|
|
|
my $pretty = $s->set_param('pretty', $pr); |
|
352
|
|
|
|
|
|
|
my $atr_cell = $s->set_param('atr_cell', $pr); |
|
353
|
|
|
|
|
|
|
$atr_cell = eval $atr_cell if $atr_cell; |
|
354
|
|
|
|
|
|
|
$atr_cell = [] if ! $atr_cell; |
|
355
|
|
|
|
|
|
|
my $esc_vars = $s->set_param('esc_vars',$pr); |
|
356
|
|
|
|
|
|
|
my $esc = ($esc_vars) ? { |
|
357
|
|
|
|
|
|
|
map { $_ => 1 } (split /,/,$esc_vars) |
|
358
|
|
|
|
|
|
|
} : {}; |
|
359
|
|
|
|
|
|
|
my $t=$s->html_tag('TR',{class=>$css_tr,attr=>$atr_tr,pretty=>1}); |
|
360
|
|
|
|
|
|
|
my ($j,$x,$txt) = (-1,$atr_td,""); |
|
361
|
|
|
|
|
|
|
my $p = {class=>$css_td,pretty=>$pretty,hr=>{}}; |
|
362
|
|
|
|
|
|
|
foreach my $k (split /,/,$cns) { |
|
363
|
|
|
|
|
|
|
++$j; $k = lc $k; |
|
364
|
|
|
|
|
|
|
if ($cr && exists $cr->{$k}{name}) { |
|
365
|
|
|
|
|
|
|
$txt = $cr->{$k}{name}; |
|
366
|
|
|
|
|
|
|
} else { |
|
367
|
|
|
|
|
|
|
$txt = $k; $txt =~ s/_/ /g; |
|
368
|
|
|
|
|
|
|
$txt = join ' ', (map {ucfirst $_} (split / /, $txt)); |
|
369
|
|
|
|
|
|
|
} |
|
370
|
|
|
|
|
|
|
if (! exists $esc->{$k}) { |
|
371
|
|
|
|
|
|
|
$txt =~ s//\>/g; |
|
372
|
|
|
|
|
|
|
} |
|
373
|
|
|
|
|
|
|
$x = ($x) ? "$x $atr_cell->[0][$j]" : $atr_cell->[0][$j] |
|
374
|
|
|
|
|
|
|
if exists $atr_cell->[0][$j]; |
|
375
|
|
|
|
|
|
|
$p->{attr} = $x; |
|
376
|
|
|
|
|
|
|
$p->{hr}{title}="$cr->{$k}{name} ($k): $cr->{$k}{desc}" |
|
377
|
|
|
|
|
|
|
if $cr && exists $cr->{$k} && |
|
378
|
|
|
|
|
|
|
exists $cr->{$k}{name} && exists $cr->{$k}{desc}; |
|
379
|
|
|
|
|
|
|
$t .= $s->html_tag('TH',$p,$txt,1); |
|
380
|
|
|
|
|
|
|
} |
|
381
|
|
|
|
|
|
|
$t .= " |
\n";
|
382
|
|
|
|
|
|
|
return $t; |
|
383
|
|
|
|
|
|
|
} |
|
384
|
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
1; |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=head1 HISTORY |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=over 4 |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item * Version 0.10 |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
This version extracts the disp_form method from CGI::Getopt class. |
|
394
|
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
0.11 Inherited the new constructor from CGI::AppBuilder. |
|
396
|
|
|
|
|
|
|
0.12 Added html_tag and table_column functions |
|
397
|
|
|
|
|
|
|
Modified html_table to use html_tag and table_column |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=item * Version 0.20 |
|
400
|
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
|
402
|
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head1 SEE ALSO (some of docs that I check often) |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
Oracle::Loader, Oracle::Trigger, CGI::Getopt, File::Xcopy, |
|
406
|
|
|
|
|
|
|
CGI::AppBuilder, CGI::AppBuilder::Message, CGI::AppBuilder::Log, |
|
407
|
|
|
|
|
|
|
CGI::AppBuilder::Config, etc. |
|
408
|
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head1 AUTHOR |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Copyright (c) 2005 Hanming Tu. All rights reserved. |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
This package is free software and is provided "as is" without express |
|
414
|
|
|
|
|
|
|
or implied warranty. It may be used, redistributed and/or modified |
|
415
|
|
|
|
|
|
|
under the terms of the Perl Artistic License (see |
|
416
|
|
|
|
|
|
|
http://www.perl.com/perl/misc/Artistic.html) |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=cut |
|
419
|
|
|
|
|
|
|
|