File Coverage

blib/lib/HTML/STable.pm
Criterion Covered Total %
statement 27 1039 2.6
branch 0 324 0.0
condition 0 33 0.0
subroutine 9 90 10.0
pod 0 52 0.0
total 36 1538 2.3


\n"; \n"; \n"; \n"; \n"; \n"; \n"; \n";
line stmt bran cond sub pod time code
1             package HTML::STable;
2              
3 1     1   1193 use strict;
  1         2  
  1         44  
4 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         2  
  1         124  
5              
6             require Exporter;
7              
8             @ISA = qw(Exporter AutoLoader);
9             # Items to export into callers namespace by default. Note: do not export
10             # names by default without a very good reason. Use EXPORT_OK instead.
11             # Do not simply export all your public functions/methods/constants.
12             @EXPORT = qw(
13            
14             );
15             $VERSION = '0.02';
16              
17              
18             # Preloaded methods go here.
19              
20             package SNode;
21 1     1   4 use strict;
  1         11  
  1         1881  
22              
23             my $obj_id = 0;
24              
25             sub new {
26 0     0     my $P = shift;
27 0           my $format = shift;
28 0           my $O = {};
29 0   0       bless $O,ref $P || $P;
30 0           $O->{ID} = $obj_id++;
31              
32 0           $format =~ tr/;/,/;
33 0           my @array = split(/,/,$format);
34 0           my %hash = ();
35 0           my $tag;
36 0           foreach $tag (@array) {
37 0           my ($key, $value) = split(/:/,$tag,2);
38 0           $hash{$key} = $value;
39             }
40 0           $O->{hash} = \%hash;
41              
42 0 0         if($hash{small}) {
43 0           $O->{small_h} = "";
44 0           $O->{small_t} = "";
45             }
46 0           my $align = $hash{"align"};
47 0           my $valign = $hash{"valign"};
48 0           my $color = $hash{"color"};
49 0           my $bgcolor = $hash{"bgcolor"};
50 0           my $background = $hash{"background"};
51 0           my $size = $hash{"size"};
52 0           my $face = $hash{face};
53 0           my $bolds = $hash{"bold"};
54 0           my $colspan = $hash{"colspan"};
55 0           my $rowspan = $hash{"rowspan"};
56 0           my $header = $hash{"header"};
57 0           my $width = $hash{"width"};
58 0 0         $O->{align} = $align ? " align=$align" : "";
59 0 0         $O->{valign} = $valign ? " valign=$valign" : "";
60 0 0         $O->{color} = $color ? " color=$color" : "";
61 0 0         $O->{size} = $size ? " size=$size" : "";
62 0 0         $O->{face} = $face ? " face=$face" : "";
63 0 0         $O->{colspan} = $colspan ? " colspan=$colspan" : "";
64 0 0         $O->{rowspan} = $rowspan ? " rowspan=$rowspan" : "";
65 0 0         $O->{bgcolor} = $bgcolor ? " bgcolor=$bgcolor" : "";
66 0 0         $O->{background} = $background ? " background=$background" : "";
67 0 0         $O->{width} = $width ? " width=$width" : "";
68 0 0         if($header eq "yes") {
69 0           $O->{head} = "
70 0           $O->{tail} = "\n";
71             } else {
72 0           $O->{head} = "
73 0           $O->{tail} = "
74             }
75 0 0         if($bolds eq "yes") {
76 0           $O->{bold_head} = "";
77 0           $O->{bold_tail} = "";
78             } else {
79 0           $O->{bold_head} = "";
80 0           $O->{bold_tail} = "";
81             }
82 0 0 0       if($color ne "" || $size ne "" || $face ne "") {
      0        
83 0           $O->{color_size_head} = "
84 0           $O->{color_size_tail} = ">";
85             } else {
86 0           $O->{color_size_head} = "";
87 0           $O->{color_size_tail} = "";
88             }
89 0           $O->{emty_format} = 0;
90 0 0         if($format eq "") {
91 0           $O->{emty_format} = 1;
92             }
93              
94 0           return $O;
95             }
96              
97             sub print {
98 0     0     my $O = shift;
99 0           my $print_string;
100 0 0         if (@_) { $print_string = shift; }
  0            
101              
102 0 0         if($O->{emty_format} == 1) {
103 0 0         if(ref($print_string) eq "CODE") {
    0          
104 0           print "";
105 0           eval($print_string->());
106 0           print "
107             } elsif(ref($print_string)) {
108 0 0         if(ref($print_string) eq "HTML::STable") {
109 0 0         if($print_string->{no_table}) {
110 0           $print_string->print();
111             } else {
112 0           print "";
113 0           $print_string->print();
114 0           print "
115             }
116             } else {
117 0           print "";
118 0           $print_string->print();
119 0           print "
120             }
121             } else {
122 0           print "$print_string
123             }
124 0           return;
125             }
126 0           my $align = $O->{align};
127 0           my $valign = $O->{valign};
128 0           my $color = $O->{color};
129 0           my $bgcolor = $O->{bgcolor};
130 0           my $background = $O->{background};
131 0           my $size = $O->{size};
132 0           my $face = $O->{face};
133 0           my $width = $O->{width};
134 0           my $bolds = $O->{bold};
135 0           my $colspan = $O->{colspan};
136 0           my $rowspan = $O->{rowspan};
137 0           my $head = $O->{head};
138 0           my $tail = $O->{tail};
139 0           my $bold_h = $O->{bold_head};
140 0           my $bold_t = $O->{bold_tail};
141 0           my $col_si_h= $O->{color_size_head};
142 0           my $col_si_t= $O->{color_size_tail};
143              
144 0 0         if(@_) {
145 0           my $color_size = 0;
146 0           my $format_string = shift;
147 0           $format_string =~ tr/;/,/;
148 0           my @array = split(/,/,$format_string);
149 0           my %hash = ();
150 0           my $tag;
151 0           foreach $tag (@array) {
152 0           my ($key, $value) = split(/:/,$tag,2);
153 0           $hash{$key} = $value;
154             }
155 0           my $temp;
156 0 0         if($temp = $hash{"align" }) { $align = " align=$temp"; }
  0            
157 0 0         if($temp = $hash{"valign" }) { $valign = " valign=$temp"; }
  0            
158 0 0         if($temp = $hash{"width" }) { $width = " width=$temp"; }
  0            
159 0 0         if($temp = $hash{"bgcolor"}) { $bgcolor = " bgcolor=$temp"; }
  0            
160 0 0         if($temp = $hash{"background"}) { $background = " background=$temp"; }
  0            
161 0 0         if($temp = $hash{"colspan"}) { $colspan = " colspan=$temp"; }
  0            
162 0 0         if($temp = $hash{"rowspan"}) { $rowspan = " rowspan=$temp"; }
  0            
163 0 0         if($temp = $hash{"size" }) { $color_size = 1; $size = " size=$temp"; }
  0            
  0            
164 0 0         if($temp = $hash{"face" }) { $color_size = 1; $face = " face=$temp"; }
  0            
  0            
165 0 0         if($temp = $hash{"color" }) { $color_size = 1; $color = " color=$temp"; }
  0            
  0            
166 0 0         if($color_size == 1) {
167 0           $col_si_h = "
168 0           $col_si_t = ">";
169             }
170 0 0         if($temp = $hash{"bolds"}) {
171 0 0         if($temp eq "yes") {
172 0           $bold_h = "";
173 0           $bold_t = "";
174             } else {
175 0           $bold_h = "";
176 0           $bold_t = "";
177             }
178             }
179 0 0         if($temp = $hash{"header"}) {
180 0 0         if($temp eq "yes") {
181 0           $head = "
182 0           $tail = "\n";
183             } else {
184 0           $head = "
185 0           $tail = "
186             }
187             }
188             }
189              
190              
191 0           print $head;
192 0           print $align;
193 0           print $valign;
194 0           print $width;
195 0           print $colspan;
196 0           print $rowspan;
197 0           print $bgcolor;
198 0           print $background;
199 0           print ">";
200 0           print $col_si_h;
201 0           print $color;
202 0           print $size;
203 0           print $face;
204 0           print $col_si_t;
205 0           print $bold_h;
206 0 0         if(ref($print_string) eq "CODE") {
    0          
207 0           eval($print_string->());
208             } elsif(ref($print_string)) {
209 0           $print_string->print();
210             } else {
211 0           print $O->{small_h};
212 0           print $print_string;
213 0           print $O->{small_t};
214             }
215 0           print $bold_t;
216 0           print $tail;
217             }
218              
219             sub string {
220 0     0     my $O = shift;
221 0           my $print_string;
222 0 0         if (@_) { $print_string = shift }
  0            
223 0           my $str = "";
224              
225 0           $str .= $O->{align};
226 0           $str .= $O->{valign};
227 0           $str .= $O->{width};
228 0           $str .= $O->{colspan};
229 0           $str .= $O->{rowspan};
230 0           $str .= $O->{bgcolor};
231 0           $str .= $O->{background};
232 0           $str .= $O->{color_size_head};
233 0           $str .= $O->{color};
234 0           $str .= $O->{size};
235 0           $str .= $O->{face};
236 0           $str .= $O->{color_size_tail};
237 0 0         if(ref($print_string)) {
238 0           $str .= $print_string->string();
239             } else {
240 0           $str .= $print_string;
241             }
242 0           print $O->{bold_tail};
243 0           $str;
244             }
245              
246              
247             sub print_list {
248 0     0     my($O,@lst) = @_;
249 0           my $i;
250 0           for($i = 0; $i <= $#lst; $i++) {
251 0           $O->print($lst[$i]);
252             }
253             }
254              
255             ##############################################
256             ## methods to access per-object data ##
257             ## ##
258             ## With args, they set the value. Without ##
259             ## any, they only retrieve it/them. ##
260             ##############################################
261              
262             sub AUTOLOAD {
263 0     0     my $O = shift;
264 0           my $attr = $SNode::AUTOLOAD;
265 0           my $argm = shift;
266              
267 0           $attr =~ s/.*:://;
268 0 0         return if $attr eq 'DESTROY';
269            
270             { # this block will turn strick refs off
271 1     1   12 no strict 'refs';
  1         2  
  1         586  
  0            
272 0           *{$SNode::AUTOLOAD} = sub {
273 0     0     my $O = shift;
274 0           my $argm = shift;
275 0 0         if($argm != "") {
276 0           $O->{$attr} = " $attr=$argm";
277             } else {
278 0           my ($dummy,$argm) = split(/=/,$O->{$attr});
279 0           return $argm;
280             }
281 0           };
282             }
283 0 0         if($argm != "") {
284 0           $O->{$attr} = " $attr=$argm";
285             } else {
286 0           my ($dummy,$argm) = split(/=/,$O->{$attr});
287 0           return $argm;
288             }
289             }
290              
291             sub header {
292 0     0     my($O,$header) = @_;
293 0           my $f = $O->{hash};
294 0           my $temp = %$f->{"header"};
295 0           %$f->{"header"} = $header;
296 0 0         if($header eq "yes") {
297 0           $O->{head} = "
298 0           $O->{tail} = "\n";
299             } else {
300 0           $O->{head} = "
301 0           $O->{tail} = "
302             }
303 0           return $temp;
304             }
305              
306             sub blank {
307 0     0     my($O,$num_of_blank) = @_;
308 0           print "";
309 0           my $i;
310 0           for($i = 0; $i < $num_of_blank; $i++) {
311 0           print " ";
312             }
313 0           print "
314             }
315              
316             sub ID {
317 0     0     my $O = shift;
318 0           $O->{ID};
319             }
320              
321             1; # so the require or use succeeds
322              
323              
324             package SDate;
325              
326 1     1   1158 use POSIX qw(strftime);
  1         13705  
  1         7  
327 1     1   988 use POSIX;
  1         2  
  1         4  
328 1     1   3892 use Time::Local;
  1         2264  
  1         132  
329              
330             my %hs =
331             (JAN=>"01", FEB=>"02", MAR=>"03", APR=>"04",MAY=>"05", JUN=>"06",
332             JUL=>"07", AUG=>"08", SEP=>"09", OCT=>"10",NOV=>"11", DEC=>"12");
333              
334             # Added by Su-Che to map month numeric value to its string representation
335             my @mon_map =
336             ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
337             "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
338              
339             use overload (
340 1         12 '<=>' => \&spaceship,
341             '""' => \&stringify,
342             'cmp' => \&compare
343 1     1   1700 );
  1         1269  
344              
345             sub new
346             {
347 0     0     my $P = shift;
348 0           my $O = {};
349 0   0       bless $O,ref $P || $P;
350              
351 0           my $date = shift;
352              
353 0           my ($m,$d,$y);
354 0           my ($sec,$min,$hour);
355 0 0         if($date) {
356 0 0         if ($date =~ "/" ) { # 12/31/1999
    0          
    0          
357 0           ($m,$d,$y) = split("/",$date);
358             } elsif ($date =~ "-" ) { # 31-12-1999
359 0           ($d,$m,$y) = split("-",$date);
360 0           $m = $hs{uc $m};
361 0 0         if( $y > 50 ) {
362 0           $y += 1900;
363             } else {
364 0           $y += 2000;
365             }
366             } elsif ($date =~ " " ) {
367 0           $date = uc $date;
368 0           ($m, $d, $y) = split(" ", $date);
369 0           $m = $hs{$m};
370             } else {
371 0           my ($a,$b,$c);
372 0           ($a,$b,$c,$d,$m,$y) = localtime($date);
373 0           $y += 1900;
374 0           $m += 1;
375             }
376             } else {
377 0           ($sec,$min,$hour,$d,$m,$y) = (localtime)[0,1,2,3,4,5];
378 0           $O->{sec} = $sec;
379 0           $O->{min} = $min;
380 0           $O->{hour} = $hour;
381 0           $y += 1900;
382 0           $m += 1;
383             }
384              
385 0           $O->{month} = $m;
386 0           $O->{day} = $d;
387 0           $O->{year} = $y;
388 0           $O->{date} = timelocal(0,0,0,$d,$m-1,$y-1900);
389              
390 0           $O;
391             }
392              
393             sub time
394             {
395 0     0     my $O = shift;
396 0           return $O->{hour}.":".$O->{min}.":".$O->{sec};
397             }
398              
399             sub diff
400             {
401 0     0     my $O = shift;
402 0           my $date = shift;
403 0 0 0       if ($date != 0 || $date ne "") {
404 0           return ceil(($O->{date} - $date->seconds) / 86400);
405             } else {
406 0           $date = new SDate();
407 0           return ceil(($O->{date} - $date->{date}) / 86400);
408             }
409             }
410              
411             sub seconds
412             {
413 0     0     my $O = shift;
414 0           $O->{date};
415             }
416              
417             #+--------------------------------------------------------------+
418             #| Modified by Su-Che Liao on September 14, 1999 |
419             #| To add a new date string format "mon dd yyyy" in addition |
420             #| to the default format "mm/dd/yyyy" |
421             #+--------------------------------------------------------------+
422             sub string
423             {
424 0     0     my $O = shift;
425 0           my $format = shift;
426              
427 0           my $d = $O->{day};
428 0 0         if($d < 10) {
429 0           $d = "0".$d;
430 0           $d =~ s/00/0/;
431             }
432              
433 0           my $m = $O->{month};
434 0 0 0       if ($format eq "mon dd yyyy") {
    0          
    0          
    0          
    0          
435 0           return $mon_map[$m-1].' '.$d.' '.$O->{year};
436             } elsif ($format eq "dd-mon-yyyy") {
437 0           return $d.'-'.$mon_map[$m-1].'-'.$O->{year};
438             } elsif ($format eq "yyyy/mm/dd") { # default format
439 0 0         if($m < 10) {
440 0           $m = "0".$m;
441 0           $m =~ s/00/0/;
442             }
443 0           return $O->{year}."/".$m."/".$d;
444             } elsif ($format eq "" || $format eq "mm/dd/yyyy") { # default format
445 0 0         if($m < 10) {
446 0           $m = "0".$m;
447 0           $m =~ s/00/0/;
448             }
449 0           return $m."/".$d."/".$O->{year};
450             } elsif ($format eq "yyyymmdd") { # default format
451 0 0         if($m < 10) {
452 0           $m = "0".$m;
453 0           $m =~ s/00/0/;
454             }
455 0           return $O->{year}.$m.$d;
456             }
457             }
458              
459             sub add_days
460             {
461 0     0     my $O = shift;
462 0           my $days = shift;
463 0           my ($sec, $min,$hou,$d,$m,$y) = localtime($O->{date} + 86400 * $days);
464 0           $m = $m+1;;
465 0           $y = $y+1900;
466 0           return SDate->new("$m/$d/$y")
467             }
468              
469             sub month_day {
470 0     0     my $O = shift;
471 0           (localtime $O->{date})[3];
472             }
473              
474             sub week_day {
475 0     0     my $O = shift;
476 0           (localtime $O->{date})[6];
477             }
478              
479             sub year_day {
480 0     0     my $O = shift;
481 0           (localtime $O->{date})[7];
482             }
483              
484             sub week_of_year {
485 0     0     my $O = shift;
486 0           int((localtime $O->{date})[7])/7+1;
487             }
488              
489             sub print {
490 0     0     my $O = shift;
491 0           print "$O->{month}/$O->{day}/$O->{year}";
492             }
493              
494             sub spaceship {
495 0     0     my ($this, $that) = @_;
496 0           my $date;
497 0 0         if(ref($this) ne "SDate") {
498 0           $date = new SDate($this);
499 0           $this = $date;
500             }
501 0 0         if(ref($that) ne "SDate") {
502 0           $date = new SDate($that);
503 0           $that = $date;
504             }
505 0           $this->{date} <=> $that->{date};
506             }
507              
508             sub stringify {
509 0     0     my $O = shift;
510 0           "$O->{month}/$O->{day}/$O->{year}";
511             }
512              
513             sub business_days {
514 0     0     my $O = shift;
515 0           my $date1 = shift;
516              
517 0           my $cycle = $O->diff($date1);
518 0           my $count = 0;
519 0           for( my $i = 0; $i < $cycle; $i++){
520 0           my $date = $date1->add_days($i);
521 0           my $number = $date->week_day;
522 0 0         if($number == 0) {next;}
  0            
523 0 0         if($number == 6) {next;}
  0            
524 0           $count++;
525             }
526 0           return $count;
527             }
528              
529             sub compare {
530 0     0     spaceship(@_);
531             }
532              
533             1;
534              
535 1     1   1830 use strict;
  1         2  
  1         9108  
536              
537             package HTML::STable;
538              
539             sub new {
540 0     0 0   my $P = shift;
541 0           my $format;
542 0 0         if(@_) {
543 0           $format = shift;
544             } else {
545 0           $format = {};
546             }
547 0           my $O = {};
548 0   0       bless $O,ref $P || $P;
549              
550 0           $O->{column_number} = -1;
551 0           $O->{row_number} = 0;
552 0           $O->{arr} = undef; # holds the table from sql
553 0           $O->{front} = (); # holds strings to put fron
554 0           $O->{back} = (); # holds strings to put back
555 0           $O->{max_row} = -1;
556 0           $O->{datafile} = "";
557 0           $O->{form} = "";
558 0           $O->{sort_flag} = 0;
559 0           $O->{sort_hsh} = ();
560 0           $O->{sort_key_array} = ();
561              
562 0           $O->{format} = $format;
563 0           $O->{row_number} = -1;
564 0           $O->{column_number} = -1;
565              
566 0           foreach ( keys %$format )
567             {
568 0           $O->{$_} = $format->{$_};
569             }
570              
571             #if table_tag => "off" than we do not want to print and
572 0 0         if($O->{table_tag}) {
573 0           $O->{no_table} = 1;
574             }
575              
576 0 0         if($format->{delimiter} eq "") {
577 0           $O->{delimiter} = ", ";
578             }
579              
580 0           $O->{flag} = undef; # holds flag for each node, if flag set than format has changed
581             # for a particular node
582 0           $O->{max_row} = -1;
583             # following information will be used in renew method of Matrix.pm
584 0           $O->{print_columns_keep} = $O->{print_columns};
585              
586 0           my $i;
587 0           $O->{column_nodes} = ();
588 0           $O->{node_nodes} = ();
589              
590 0 0         if($format->{filename}) {
591 0 0         open(FH,">>$format->{filename}") || warn "could not open $format->{filename}";
592 0           *STDOUT = *FH;
593 0           $O->{fh} = *FH;
594             } else {
595 0           $O->{fh} = *STDOUT;
596             }
597 0           $O->{cur_row} = 0;
598              
599 0           $O->{cur_col} = 0;
600 0           return $O;
601             }
602              
603             sub print {
604 0     0 0   my $O = shift;
605 0           my $i;
606 0           my $row_num = $O->{row_number};
607 0           $O->print_head;
608 0 0         if($O->{sort_flag}) {
609 0           my @keys = @{$O->{sort_key_array}};
  0            
610 0           my %hsh = %{$O->{sort_hsh}};
  0            
611 0           my $key;
612 0           my $rn = 0;
613 0           foreach $key (@keys) {
614             # we add one therefore we must remove it #@#@
615 0           $O->print_row($hsh{$key} - 1); #@#@
616 0           $rn++;
617             }
618             # this rows added after sort therefore they will be displayed
619             # at the bottom without a sort
620 0           for(my $i = $rn; $i <= $row_num; $i++) {
621 0           $O->print_row($i);
622             }
623             } else {
624             #write the rest of the table
625 0           for ($i = 0; $i <= $row_num; $i++) {
626 0           $O->print_row($i);
627             }
628             }
629 0           $O->print_tail;
630             }
631              
632             sub nextrow {
633 0     0 0   my $O = shift;
634 0           $O->{cur_row}++;
635 0           $O->{cur_col} = 0;
636             }
637              
638             sub insert {
639 0     0 0   my $O = shift;
640 0           my ($arg1,$arg2,$arg3,$arg4) = @_;
641 0           my ($row,$col,$txt,$fmt);
642              
643             # insert([ values ], "optional_format")
644             # insert([ values ], [optional_format])
645 0 0         if(ref($arg1) eq "ARRAY") {
646 0           $col = 0;
647 0           $row = $O->{row_number} + 1;
648 0           $O->{cur_row} = $row;
649 0           $fmt = $arg2;
650 0 0         if(ref($fmt) eq "ARRAY") {
651 0           foreach (@{$arg1}) {
  0            
652 0           $O->insert($row,$col,$arg1->[$col],$fmt->[$col]);
653 0           $col++;
654             }
655             } else {
656 0           foreach (@{$arg1}) {
  0            
657 0           $O->insert($row,$col,$_,$fmt);
658 0           $col++;
659             }
660             }
661 0           return;
662             }
663             # insert(row, [ values ], "optional_format")
664 0 0         if(ref($arg2) eq "ARRAY") {
665 0           $col = 0;
666 0           $row = $arg1;
667 0           $fmt = $arg3;
668 0 0         if(ref($fmt) eq "ARRAY") {
669 0           foreach (@{$arg2}) {
  0            
670 0           $O->insert($row,$col,$arg2->[$col],$fmt->[$col]);
671 0           $col++;
672             }
673             } else {
674 0           foreach (@{$arg2}) {
  0            
675 0           $O->insert($row,$col,$arg2->[$col],$fmt);
676 0           $col++;
677             }
678             }
679 0           return;
680             }
681              
682             # insert(row, col, [ values ], "optional_format")
683 0 0         if(ref($arg3) eq "ARRAY") {
684 0           $row = $arg1;
685 0           $col = $arg2;
686 0           $fmt = $arg4;
687 0           my $i = 0;
688 0 0         if(ref($fmt) eq "ARRAY") {
689 0           foreach (@{$arg3}) {
  0            
690 0           $O->insert($row,$col,$arg3->[$i],$fmt->[$i]);
691 0           $i++;
692 0           $col++;
693             }
694             } else {
695 0           foreach (@{$arg3}) {
  0            
696 0           $O->insert($row,$col,$arg3->[$i++],$fmt);
697 0           $col++;
698             }
699             }
700 0           return;
701             }
702             # insert(value, "optional_format")
703             # delete this only keep whatever inside else
704 0 0         if($#_ <= 1) {
705 0           $txt = $arg1;
706 0           $fmt = $arg2;
707 0 0         if($txt eq "\n") {
708 0           $O->nextrow;
709 0           return;
710             }
711 0           $col = $O->{cur_col};
712 0 0         if($O->{cur_row} == $O->{row_number}) {
713 0           $row = $O->{row_number} + 1;
714             } else {
715 0           $row = $O->{row_number};
716             }
717 0           $O->{cur_col}++;
718             } else {
719 0           ($row,$col,$txt,$fmt) = ($arg1,$arg2,$arg3,$arg4);
720             }
721              
722 0 0 0       if($row < 0 || $col < 0) {
723 0           my ($package, $filename, $line) = caller(0);
724 0           print ERROR ref($O).": Error at $filename at line $line \n";
725 0           print ERROR ref($O).": Negative index ROW = $row COL = $col \n";
726 0           exit;
727             }
728              
729 0 0         if($O->{row_number} < $row) {
730 0           $O->{row_number} = $row;
731             }
732 0 0         if($O->{column_number} < $col) {
733 0           $O->{column_number} = $col;
734             }
735              
736 0 0         if($O->{alter_row_formats}) {
737 0           my $count = $#{$O->{alter_row_formats}} + 1;
  0            
738 0           my $index = $row % $count;
739 0           $count = $#{$O->{headers}};
  0            
740 0 0         if($count < 0) { $count = $col; }
  0            
741 0           for(my $j = $col; $j <= $count; $j++)
742             {
743 0 0         if($O->{chessboard}) {
744 0           $index = ($row + $j) % 2;
745             }
746 0           $fmt = $O->{alter_row_formats}[$index];
747 0           $O->{node_nodes}[$row][$j] = new SNode($fmt);
748 0           $O->{flag}[$row][$j] = 200;
749             }
750 0           $O->{arr}[$row][$col] = $txt;
751 0           return;
752             }
753 0           $O->{flag}[$row][$col] = 100; # value inserted but no format changes
754 0 0         if($fmt ne "") { #if there is a format string
755              
756             # add new format values into front of body_format. First accurance has
757             # precedence, if ve redefine color old color will be overridden.
758             # $fmt = $fmt.";".$O->{body_format};
759             # node format has higher precedence that column_formats and
760             # column formats has higher precedence than body_format
761              
762 0           $fmt = $O->{body_format}.";".$O->{column_formats}[$col].";".$fmt;
763 0           $O->{node_nodes}[$row][$col] = new SNode($fmt);
764 0           $O->{flag}[$row][$col] = 200; # value inserted and there is format changes
765             }
766 0           $O->{arr}[$row][$col] = $txt;
767             }
768              
769             sub column_insert {
770 0     0 0   my $O = shift;
771 0           my ($arg1,$arg2,$arg3,$arg4) = @_;
772 0           my ($row,$col,$ar,$fmt);
773              
774 0 0         if(ref($arg2) eq "ARRAY")
775             {
776 0           $row = 0;
777 0           $col = $arg1;
778 0           $ar = $arg2;
779 0           $fmt = $arg3;
780             } else {
781 0           $row = $arg1;
782 0           $col = $arg2;
783 0           $ar = $arg3;
784 0           $fmt = $arg4;
785             }
786 0           foreach (@{$ar}) {
  0            
787 0           $O->insert($row,$col,$ar->[$row],$fmt);
788 0           $row++;
789             }
790             }
791              
792             sub delimiter {
793 0     0 0   my $O = shift;
794 0           return $O->{delimiter};
795             }
796              
797             sub cell_format
798             {
799 0     0 0   my $O = shift;
800 0           my $row = shift;
801 0           my $col = shift;
802 0           my ($ar) = @_;
803              
804 0 0         if(ref($ar)) {
805 0           my $fmt;
806 0           foreach $fmt (@{$ar}) {
  0            
807 0           $O->{node_nodes}[$row][$col] = new SNode($fmt);
808             # value inserted and there is format changes
809 0           $O->{flag}[$row][$col] = 200;
810 0           $col++;
811             }
812             } else {
813 0           my $fmt = $ar;
814 0           $O->{node_nodes}[$row][$col] = new SNode($fmt);
815             # value inserted and there is format changes
816 0           $O->{flag}[$row][$col] = 200;
817             }
818             }
819              
820             sub row_format
821             {
822 0     0 0   my $O = shift;
823 0           my $row = shift;
824 0           my $fmt = shift;
825 0           my $cn = $O->{column_number};
826 0           my $i;
827 0           for($i = 0; $i <= $cn; $i++) {
828 0           $O->cell_format($row,$i,$fmt);
829             }
830             }
831              
832             sub print_head {
833 0     0 0   my $O = shift;
834 0           my ($i,$j);
835 0           $O->{head_nodes} = new SNode($O->{head_format});
836 0           my $temp_node;
837 0           my $col_num = $#{$O->{print_columns}};
  0            
838 0           my $row_num = $O->{row_number};
839              
840 0 0         if($col_num <= $O->{column_number}) {
841 0           $col_num = $O->{column_number};
842 0 0         if($#{$O->{print_columns}} < 0) {
  0            
843 0           $O->{print_columns} = [0..$col_num];
844             } else {
845 0           $col_num = $#{$O->{print_columns}};
  0            
846             }
847             }
848              
849 0 0         if($O->{title}) {
850 0           $O->title($O->{title});
851             }
852 0 0         if($O->{date} eq "yes") {
853 0           $O->date;
854             } else {
855 0           $O->title($O->{date});
856             }
857 0 0         if($O->{sub_title}) {
858 0           $O->_sub_title;
859             }
860              
861 0 0         if($row_num < 0) {
862 0 0         if(ref($O->{empty_msg}) eq "HTML::STable") {
863 0           $O->{empty_msg}->print;
864             } else {
865 0           print "
866            
$O->{empty_msg}
";
867             }
868 0           return;
869             }
870              
871 0           for($i = 0; $i <= $col_num; $i++) {
872 0           my $k = $O->{print_columns}[$i];
873 0 0         if($O->{column_formats}[$k] eq "" ) {
874 0           $O->{column_nodes}[$k] = new SNode($O->{body_format});
875             } else {
876 0           my $fmt = $O->{body_format}.";".$O->{column_formats}[$k];
877 0           $O->{column_nodes}[$k] = new SNode($fmt);
878             }
879             }
880              
881 0 0         if($O->{no_table} != 1) {
882 0           my $fmt = $O->{table_format};
883 0           $fmt =~ tr/;/ /;
884 0           $fmt =~ tr/:/=/;
885 0 0         if(!($fmt =~ /align/)) {
886 0           $fmt .= " align=center"; # default alignment for table
887             }
888 0           print "\n\n"; \n"; \n"; \n"; \n";
889             }
890              
891             #first write headers
892 0 0         if($O->{headers}) { # if present than headers will be printed
893 0           print "
894 0           $temp_node = $O->{head_nodes};
895 0           for($j = 0; $j <= $col_num; $j++) {
896 0           my $k = $O->{print_columns}[$j];
897 0           $temp_node->print($O->{headers}[$k]);
898             }
899 0           print "
900             }
901             }
902              
903             sub print_row {
904 0     0 0   my $O = shift;
905 0           my $i = shift;
906 0           my $j;
907             my $temp_node;
908 0           my $col_num = $#{$O->{print_columns}};
  0            
909 0           print "
910 0           for($j = 0; $j <= $col_num; $j++) {
911 0           my $k = $O->{print_columns}[$j];
912 0           $temp_node = $O->{column_nodes}[$k];
913 0 0 0       if($O->{flag}[$i][$k] == 100 || $O->{flag}[$i][$k] == 200) {
914 0 0         if($O->{flag}[$i][$k] == 200) {
915 0           $temp_node = $O->{node_nodes}[$i][$k];
916             }
917             # check whether colspan or rowspan has been used or not,
918             # if they are used set $O->{flag}[?][?] = 400
919             # by doing that table printing will skip extra cells
920 0           my $col_span = $temp_node->colspan;
921 0 0         if($col_span != 0) {
922 0           my $c;
923 0           for($c = 1; $c < $col_span; $c++) {
924 0           $O->{flag}[$i][$k+$c] = 400;
925             }
926             }
927 0           my $row_span = $temp_node->rowspan;
928 0 0         if($row_span != 0) {
929 0           my $r;
930 0           for($r = 1; $r < $row_span; $r++) {
931 0           $O->{flag}[$i+$r][$k] = 400;
932             }
933             }
934 0 0 0       if($row_span != 0 && $col_span != 0) {
935 0           my ($c,$r);
936 0           for($c = 1; $c < $col_span; $c++) {
937 0           for($r = 1; $r < $row_span; $r++) {
938 0           $O->{flag}[$i+$r][$k+$c] = 400;
939             }
940             }
941             }
942 0           my $tobj = $O->{arr}[$i][$k];
943 0 0         if(ref($tobj)) {
944 0           $temp_node->print($tobj);
945             } else {
946 0 0         if($tobj =~ "
") {
947 0           $temp_node->print($O->{front}[$i][$j].
948             $tobj.
949             $O->{back}[$i][$k]." ");
950             } else {
951 0 0 0       if($tobj eq "" && $O->{empty_cell_text}) {
952 0           $O->_null_empty("empty",$k,$temp_node);
953             } else {
954 0           $temp_node->print($O->{front}[$i][$j].
955             $tobj.
956             $O->{back}[$i][$k]."  ");
957             }
958             }
959             }
960             } else {
961 0 0         if($O->{flag}[$i][$k] != 400) {
962 0 0         if($O->{null_cell_text}) {
963 0           $O->_null_empty("null",$k,$temp_node);
964             } else {
965 0           $temp_node->print("  ");
966             }
967             }
968             }
969             }
970 0           print "
971             }
972              
973             sub print_tail {
974 0     0 0   my $O = shift;
975 0 0         if($O->{no_table} != 1) {
976 0           print "
\n";
977             }
978              
979 0           my $str = $O->{download};
980             # if $str ne "" then download the data
981 0 0         if($str) {
982 0           $O->download;
983 0           $O->show_button($str);
984             }
985             }
986              
987             sub table_format {
988 0     0 0   my $O = shift;
989 0           my $fmt = shift;
990 0           $fmt =~ tr/;/ /;
991 0           $fmt =~ tr/:/=/;
992 0           $O->{table_format} = $fmt;
993             }
994              
995 0     0 0   sub head_format { my $O = shift; $O->{head_format} = shift;}
  0            
996 0     0 0   sub body_format { my $O = shift; $O->{body_format} = shift;}
  0            
997 0     0 0   sub column_formats { my $O = shift; $O->{column_formats} = shift;}
  0            
998 0     0 0   sub print_columns { my $O = shift; $O->{print_columns} = shift;}
  0            
999 0     0 0   sub headers { my $O = shift; $O->{headers} = shift;}
  0            
1000 0     0 0   sub empty_msg { my $O = shift; $O->{empty_msg} = shift;}
  0            
1001 0     0 0   sub sub_title { my $O = shift; $O->{sub_title} = shift;}
  0            
1002 0     0 0   sub alter_row_formats { my $O = shift; $O->{alter_row_formats} = shift;}
  0            
1003              
1004 0     0 0   sub my_insert {my $O = shift; sub { $O->insert(@_)};}
  0     0      
  0            
1005 0     0 0   sub my_linkto {my $O = shift; sub { $O->linkto(@_)};}
  0     0      
  0            
1006 0     0 0   sub my_script {my $O = shift; sub { $O->script(@_)};}
  0     0      
  0            
1007              
1008             sub sort {
1009 0     0 0   require Sort::Fields;
1010 0           my $O = shift;
1011 0           my $cols = shift;
1012              
1013 0           my %hsh;
1014              
1015 0           my ($i,$j);
1016              
1017 0           my $row_num = $O->{row_number};
1018 0           my $col_num = $O->{column_number};
1019              
1020 0           my %d_indx = ();
1021 0           my %a_indx = ();
1022             # convert d to n for numeric date sort
1023 0           foreach ( @$cols ) {
1024             # increment all column numbers by one
1025 0           s/([0-9]+)/$1+1/e;
  0            
1026 0 0         if(/d/) {
1027 0           my $ind = $_;
1028 0           $ind =~ tr/[\-d]/ /;
1029 0           $ind =~ s/ //g;
1030 0           tr/d/n/;
1031 0           $d_indx{$ind} = 1;
1032             }
1033             # remove "i" from column name
1034 0 0         if(/i/) {
1035 0           my $ind = $_;
1036 0           $ind =~ tr/[\-i]/ /;
1037 0           $ind =~ s/ //g;
1038 0           s/i//;
1039 0           $a_indx{$ind} = 1;
1040             }
1041 0 0         if(/A/) { # convert A tag to 0 to obey all rules of Sort::Fields
1042 0           tr/A/0/;
1043             }
1044             }
1045 0           for($i = 0; $i <= $row_num; $i++) {
1046 0           my $tmp = "";
1047 0           my @arr = ();
1048 0           for($j = 0; $j <= $col_num; $j++) {
1049 0 0         if($d_indx{$j+1}) {
    0          
1050 0           push(@arr, SDate->new($O->node($i,$j))->seconds);
1051             } elsif($a_indx{$j+1}) {
1052 0           push(@arr, uc ($O->node($i,$j)));
1053             } else {
1054 0           my $val;
1055 0 0         if(ref($O->node($i,$j))) {
1056 0           $val = ref($O->node($i,$j));
1057             } else {
1058 0           $val = $O->node($i,$j);
1059             }
1060 0           $val =~ s/\://g;
1061 0           push(@arr, $val);
1062             }
1063             }
1064 0           $tmp = join("\:",@arr);
1065 0           while(exists($hsh{$tmp})) {
1066 0           $tmp .= "a";
1067             }
1068             # we add 1 here to make while loop work with $i = 0 #@#@
1069 0           $hsh{$tmp} = $i + 1; #@#@
1070             }
1071              
1072 0           my @keys;
1073              
1074 0           @keys = Sort::Fields::fieldsort('\:', $cols, (keys %hsh));
1075              
1076 0           $O->{sort_hsh} = \%hsh;
1077 0           $O->{sort_key_array} = \@keys;
1078 0           $O->{sort_flag} = 1;
1079             }
1080              
1081             sub sum
1082             {
1083 0     0 0   my $O = shift;
1084 0           my $col = shift;
1085 0           my $row = $O->{row_number};
1086              
1087 0           my $sum = 0;
1088 0           for(my $i = 0; $i <= $row; $i++) {
1089 0           $_ = $O->node($i,$col);
1090 0           tr/[$a-zA-Z]//;
1091 0           s/,//g;
1092 0           $sum += $_;
1093             }
1094 0 0         if(@_) {
1095 0 0         if($_[0]->{comma})
1096             {
1097 0           $_ = $sum;
1098 0           1 while s/^(-?\d+)(\d{3})/$1,$2/;
1099 0 0         if($_[0]->{dolar}) {
1100 0           return '$'.$_;
1101             }
1102 0           return $_;
1103             }
1104             }
1105              
1106 0           return $sum;
1107             }
1108              
1109             sub table_tag_off {
1110 0     0 0   my $O = shift;
1111 0           $O->{no_table} = 1;
1112 0           return $O;
1113             }
1114              
1115             sub null_cell_text {
1116 0     0 0   my $O = shift;
1117 0           $O->{null_cell_text} = shift;
1118             }
1119              
1120             sub null_cell_format {
1121 0     0 0   my $O = shift;
1122 0           $O->{null_cell_format} = shift;
1123             }
1124              
1125             sub empty_cell_text {
1126 0     0 0   my $O = shift;
1127 0           $O->{empty_cell_text} = shift;
1128             }
1129              
1130             sub empty_cell_format {
1131 0     0 0   my $O = shift;
1132 0           $O->{empty_cell_format} = shift;
1133             }
1134             sub _null_empty {
1135 0     0     my $O = shift;
1136 0           my $typ = shift;
1137 0           my $k = shift;
1138 0           my $temp_node = shift;
1139 0           my $txt = $typ."_cell_text";
1140 0           my $fmt = $typ."_cell_format";
1141 0 0         if(ref($O->{$txt})) {
1142 0           my @val = @{$O->{$txt}};
  0            
1143 0 0         if(ref($O->{$fmt})) {
1144 0           my @fmt = @{$O->{$fmt}};
  0            
1145 0           my $node = SNode->new($fmt[$k]);
1146 0           $node->print($val[$k]);
1147             } else {
1148 0 0         if($O->{$fmt}) {
1149 0           my $node = SNode->new($O->{$fmt});
1150 0           $node->print($val[$k]);
1151             } else {
1152 0           $temp_node->print($val[$k]);
1153             }
1154             }
1155             } else {
1156 0 0         if($O->{$fmt}) {
1157 0 0         if(ref($O->{$fmt})) {
1158 0           my @fmt = @{$O->{$fmt}};
  0            
1159 0           my $node = SNode->new($fmt[$k]);
1160 0           $node->print($O->{$txt});
1161             } else {
1162 0           my $node = SNode->new($O->{$fmt});
1163 0           $node->print($O->{$txt});
1164             }
1165             } else {
1166 0           $temp_node->print($O->{$txt});
1167             }
1168             }
1169             }
1170              
1171             sub rown {
1172 0     0 0   my $O = shift;
1173 0           return $O->{row_number};
1174             }
1175              
1176             sub coln {
1177 0     0 0   my $O = shift;
1178 0           return $O->{column_number};
1179             }
1180              
1181             sub renew {
1182 0     0 0   my $O = shift;
1183 0           $O->{column_number} = -1;
1184 0           $O->{row_number} = -1;
1185 0           $O->{arr} = ();
1186 0           $O->{front} = ();
1187 0           $O->{back} = ();
1188 0           $O->{max_row} = -1;
1189 0           $O->{datafile} = "";
1190 0           $O->{form} = "";
1191 0           $O->{print_columns} = $O->{print_columns_keep};
1192              
1193 0           return $O;
1194             }
1195              
1196             # use display method instead of print;
1197 0     0 0   sub display { my $O = shift; $O->print(); };
  0            
1198              
1199              
1200             # node function without argument returns the scalar value contained in the node
1201             # however if node function is called with an argument, it will set node valeue
1202             # to the argument, BUT will return whatever value existed in the node before
1203             # set operation
1204              
1205             sub node {
1206 0     0 0   my ($O,$row,$col) = @_;
1207 0 0         unless($col =~ /\D/) {
1208 0           return $O->{arr}[$row][$col];
1209             } else {
1210 0           return $O->{arr}[$row]{$col};
1211             }
1212             }
1213              
1214             sub cell {
1215 0     0 0   my ($O,$row,$col,$val) = @_;
1216 0 0         if($val) {
1217 0           $O->{arr}[$row][$col] = $val;
1218             } else {
1219 0 0         unless($col =~ /\D/) {
1220 0           return $O->{arr}[$row][$col];
1221             } else {
1222 0           return $O->{arr}[$row]{$col};
1223             }
1224             }
1225             }
1226              
1227             sub row {
1228 0     0 0   my ($O,$row) = @_;
1229 0 0         if(ref($O->{arr}[$row]) eq "ARRAY") {
1230 0           return @{$O->{arr}[$row]};
  0            
1231             } else {
1232 0           return %{$O->{arr}[$row]};
  0            
1233             }
1234             }
1235              
1236             sub column {
1237 0     0 0   my ($O,$col) = @_;
1238 0           my $rn = $O->{row_number};
1239 0           my $i;
1240 0           my @arr = ();
1241 0           for($i = 0; $i < $rn; $i++) {
1242 0           $arr[$i] = $O->node($i,$col);
1243             }
1244 0 0         if($O->node($rn,$col) ne "") {
1245 0           $arr[$rn] = $O->node($i,$col);
1246             }
1247              
1248 0           return @arr;
1249             }
1250              
1251             sub hash {
1252 0     0 0   my ($O,$col1, $col2) = @_;
1253 0           my $rn = $O->{row_number};
1254 0           my $i;
1255 0           my %hsh = ();
1256 0           for($i = 0; $i < $rn; $i++) {
1257 0           $hsh{$O->node($i,$col1)} = $O->node($i,$col2);
1258             }
1259 0 0         if($O->node($rn,$col2) ne "") {
1260 0           $hsh{$O->node($rn,$col1)} = $O->node($rn,$col2);
1261             }
1262 0           return %hsh;
1263             }
1264              
1265             # this sub reads content of a file and load's matrix with this data
1266             sub read {
1267 0     0 0   my $O = shift;
1268 0           my $ch = shift; # character used as field delimiter
1269 0           my $file = shift; # file to be read
1270              
1271 0 0         open (FILER, "$file") or warn "Could't open $file\n";
1272              
1273 0           my $i = 0;
1274 0           while() {
1275 0           chop;
1276 0           my @larr = split(/$ch/);
1277              
1278 0           my $len = $#larr;
1279 0 0         if($len > $O->{column_number}) {
1280 0           $O->{column_number} = $len;
1281             }
1282 0           $O->{arr}[$i] = [ split(/$ch/) ];
1283 0           $i++;
1284             }
1285 0           $O->{row_number} = $i;
1286            
1287 0           close(FILER);
1288             }
1289              
1290             sub maxRow {
1291 0     0 0   my ($O) = shift;
1292 0           $O->{max_row} = shift;
1293             }
1294              
1295             sub form {
1296 0     0 0   my $O = shift;
1297 0 0         @_ ? $O->{form} = shift : $O->{form};
1298             }
1299              
1300             sub title {
1301 0     0 0   my $O = shift;
1302 0           my $title = shift;
1303 0 0         if(ref($title)) {
1304 0           my $tit;
1305 0           foreach $tit (@{$title}) {
  0            
1306 0           print "

$tit


\n";
1307             }
1308             } else {
1309 0 0         if($title) {
1310 0           print "

$title

\n";
1311             }
1312             }
1313             }
1314              
1315             sub _sub_title {
1316 0     0     my $O = shift;
1317 0           my $len = $#{$O->{sub_title}};
  0            
1318 0           my $j;
1319             my $node;
1320 0           for($j = 0; $j <= $len; $j++) {
1321 0 0         if(ref($O->{sub_title_format})) {
1322 0           $node = new SNode($O->{sub_title_format}->[$j]);
1323             } else {
1324 0           $node = new SNode($O->{sub_title_format});
1325             }
1326 0           print '
';
1327 0           $node->print($O->{sub_title}->[$j]);
1328 0           print '
';
1329             }
1330             }
1331              
1332             sub date {
1333 0     0 0   my $O = shift;
1334 0           my $flag = shift;
1335 0           my $date;
1336             my $date_phrase;
1337 0           $_ = POSIX::ctime(time);
1338             # meaning of $[d] is given below
1339             # Mon Sep 21 10:49:15 1998
1340             # $1 $2 $3 $4 $5
1341 0 0         if (/(\w*)\s*(\w*)\s*(\d*)\s*(..:..:..)\s*(....)/) {
1342 0           $date_phrase = "Report generated $1 $2 $3, $5 at $4";
1343 0           $date = "$1 $2 $3, $5 at $4";
1344             }
1345              
1346 0 0         if($flag == 1) {
1347 0           return $date;
1348             } else {
1349 0           $O->{phrase} = $date_phrase;
1350 0           print "

$date_phrase

\n";
1351             }
1352             }
1353              
1354             sub clear {
1355 0     0 0   my ($O,$row,$col) = @_;
1356 0           $O->{front}[$row][$col] = "";
1357 0           $O->{back}[$row][$col] = "";
1358             }
1359              
1360             sub change {
1361 0     0 0   my ($O,$row,$col,$tx1,$tx2) = @_;
1362 0           $O->{front}[$row][$col] = $tx1.$O->{front}[$row][$col];
1363 0           $O->{back}[$row][$col] = $O->{back}[$row][$col].$tx2;
1364             }
1365              
1366             sub script {
1367 0     0 0   my $O = shift;
1368 0           my $arg1 = shift;
1369 0           my $arg2 = shift;
1370              
1371 0 0         if($arg2 =~ /[a-zA-Z]/) {
1372             # if user call this function as $ip->javascript(0,"SelectSite",7,8)'
1373             # this routine will produce something like
1374             # Site_Name
1375             # at the first line 7 and 8 are column number containing site_id
1376             # and cust_id respectively
1377 0           my $col = $arg1;
1378 0           my $prg = $arg2;
1379 0           my $cols = shift;
1380            
1381 0           my ($i,$j);
1382 0           my $rn = $O->{row_number};
1383 0           my $tx2 = "
1384 0 0         if($O->{form} ne "") {
1385 0           $tx2 .= $O->{form};
1386 0 0         if($#$cols > 0) {
1387 0           $tx2 .= ",";
1388             }
1389             }
1390              
1391 0           for($i = 0; $i <= $rn; $i++) {
1392 0           my $tx3 = "";
1393 0           for($j = 0; $j <= $#$cols; $j++) {
1394 0           $_ = $O->{arr}[$i][$cols->[$j]];
1395 0 0         if(/^[-+]?[0-9]+(\.[0-9]*)?$/) {
1396 0           $tx3 .= $_;
1397             } else {
1398 0 0         if(/this\./) {
1399 0           $tx3 .= $_;
1400             } else {
1401 0           $tx3 .= "\"".$_."\"";
1402             }
1403             }
1404 0 0         if($j < $#$cols) {
1405 0           $tx3 .= ",";
1406             }
1407             }
1408 0           $O->{front}[$i][$col] = $tx2.$tx3.")> ";
1409 0           $O->{back}[$i][$col] = " ";
1410             }
1411             } else {
1412 0           my $row = $arg1;
1413 0           my $col = $arg2;
1414 0           my $prg = shift;
1415 0           my $arg = shift;
1416 0           my $tx2 = "
1417 0           foreach ( @{$arg}) {
  0            
1418             # if(/[a-zA-Z_]/) {
1419             # $_ = '"'.$_.'"';
1420             # }
1421 0 0         if(/[a-zA-Z_]/) {
1422 0 0         if(/this\./) {
1423 0           $_ = $_;
1424             } else {
1425 0           $_ = '"'.$_.'"';
1426             }
1427             }
1428             }
1429 0           my $tx3 = join(',',@{$arg});
  0            
1430 0           $O->{front}[$row][$col] = $tx2.$tx3.")> ";
1431 0 0         if($O->{arr}[$row][$col] =~ "") {
1432 0           $O->{back}[$row][$col] = " ";
1433             } else {
1434 0           $O->{back}[$row][$col] = "";
1435             }
1436             }
1437             }
1438              
1439              
1440             sub back {
1441 0     0 0   my $O = shift;
1442 0           my $row = shift;
1443 0           my $col = shift;
1444 0 0         if(@_) {
1445 0           my $tmp = $O->{back}[$row][$col];
1446 0           $O->{back}[$row][$col] = shift;
1447 0           return $tmp;
1448             } else {
1449 0           return $O->{back}[$row][$col];
1450             }
1451             }
1452              
1453             sub front {
1454 0     0 0   my $O = shift;
1455 0           my $row = shift;
1456 0           my $col = shift;
1457              
1458 0 0         if(@_) {
1459 0           my $tmp = $O->{front}[$row][$col];
1460 0           $O->{front}[$row][$col] = shift;
1461 0           return $tmp;
1462             } else {
1463 0           return $O->{front}[$row][$col];
1464             }
1465             }
1466              
1467             sub linkto {
1468 0     0 0   my $O = shift;
1469 0           my $row = shift;
1470 0           my $col = shift;
1471             # set back value to anchor closing, user can overrite it
1472             # by colling back function
1473 0           $O->{back}[$row][$col] = " ";
1474 0           $_ = shift;
1475 0           $O->{front}[$row][$col] = "";
1476             }
1477              
1478             sub download {
1479 0     0 0   my $O = shift;
1480              
1481 0           my $col_num = $#{$O->{print_columns}};
  0            
1482 0           my $row_num = $O->{row_number};
1483             ### This lines moved from print_head method to run
1484             ### download function before print function
1485 0 0         if($col_num <= $O->{column_number}) {
1486 0           $col_num = $O->{column_number};
1487 0 0         if($#{$O->{print_columns}} < 0) {
  0            
1488 0           $O->{print_columns} = [0..$col_num];
1489             } else {
1490 0           $col_num = $#{$O->{print_columns}};
  0            
1491             }
1492             }
1493             #####
1494 0           my $datafile = "data.".$$;
1495 0           $O->{datafile} = $datafile;
1496              
1497             # open (FILE, '>>/tmp/'.$datafile);
1498 0           open (FILE, '>C:/apache/tmp/'.$datafile);
1499              
1500 0 0         if(ref($O->{title})) {
1501 0           my $tit;
1502 0           foreach $tit (@{$O->{title}}) {
  0            
1503 0           print FILE "$tit\r\n";
1504             }
1505             } else {
1506 0           print FILE "$O->{title}\r\n";
1507             }
1508 0           print FILE "$O->{phrase}\r\n";
1509 0           my $len = $#{$O->{sub_title}};
  0            
1510 0           my $j;
1511 0           for($j = 0; $j <= $len; $j++) {
1512 0           $_ = $O->{sub_title}[$j];
1513 0           s/
/ /g;
1514 0           print FILE $_,"\r\n";
1515             }
1516 0           print FILE "\r\n"; "; \n"; "; \n"; "; \n";
1517             #for header
1518 0           print FILE "
1519 0           my $rn = $O->{row_number};
1520 0 0         if($rn >= 0) {
1521 0           my $len = $#{$O->{headers}};
  0            
1522 0           for($j = 0; $j <= $len; $j++)
1523             {
1524 0           print FILE "";
1525 0           print FILE $O->{headers}[$j];
1526             }
1527             } else {
1528 0           print FILE $O->{empty_msg};
1529             }
1530 0           print FILE "
1531              
1532             #for table
1533 0           my $i;
1534 0           $len = $#{$O->{print_columns}};
  0            
1535 0 0         if($O->{sort_flag}) {
1536 0           my $tmp1 = $O->{sort_key_array};
1537 0           my @keys = @$tmp1;
1538 0           my $key;
1539 0           foreach $key (@keys) {
1540 0           print FILE "
1541 0           my $tmp2 = $O->{sort_hsh};
1542 0           my %tmp = %$tmp2;
1543             # we added one in Table.pm to this value #@#@
1544 0           $i = $tmp{$key} - 1; #@#@
1545 0           for $j (0 .. $len) {
1546 0           print FILE "";
1547 0           my $tO = $O->{arr}[$i][$O->{print_columns}[$j]];
1548 0 0         if(ref($tO) eq "HTML::STable") {
    0          
1549 0           my @tarr = $tO->column(0);
1550 0           $_ = @tarr;
1551             } elsif(ref($tO)) {
1552 0           $_ = $tO->download;
1553             } else {
1554 0           $_ = $tO;
1555             }
1556 0 0         if ($_) {
1557 0           s/
/ /g;
1558             } else {
1559 0           $_ = " ";
1560             }
1561 0           print FILE $_;
1562             }
1563 0           print FILE "
1564             }
1565             } else {
1566 0           for($i = 0; $i <= $rn; $i++) {
1567 0           print FILE "
1568 0           for $j ( 0 .. $len) {
1569 0           print FILE "";
1570 0           my $tO = $O->{arr}[$i][$O->{print_columns}[$j]];
1571 0 0         if(ref($tO) eq "HTML::STable") {
    0          
1572 0           $_ = $tO->column(0);
1573             } elsif(ref($tO)) {
1574 0           $_ = $tO->download;
1575             } else {
1576 0           $_ = $tO;
1577             }
1578 0 0         if ($_) {
1579 0           s/
/ /g;
1580             } else {
1581 0           $_ = " ";
1582             }
1583 0           print FILE $_;
1584             }
1585 0           print FILE "
1586             }
1587             }
1588 0           print FILE "
";
1589 0           close (FILE);
1590             }
1591              
1592             sub show_button
1593             {
1594 0     0 0   my $O = shift;
1595 0           my $str = shift;
1596 0           my $datafile = $O->{datafile};
1597              
1598 0 0         if($str) {
1599              
1600 0           print "

";
1601 0           print qq{
1602             NAME="download"
1603             VALUE="$str"
1604             ONCLICK="location.href='download.pl?process_id=$$';">};
1605 0           print "";
1606             }
1607             }
1608              
1609             1;
1610             # Autoload methods go after =cut, and are processed by the autosplit program.
1611              
1612             __END__