File Coverage

blib/lib/DBIx/SQLCrosstab/Format.pm
Criterion Covered Total %
statement 306 396 77.2
branch 114 176 64.7
condition 24 44 54.5
subroutine 25 31 80.6
pod 6 9 66.6
total 475 656 72.4


line stmt bran cond sub pod time code
1             package DBIx::SQLCrosstab::Format;
2 1     1   6723 use strict;
  1         2  
  1         43  
3 1     1   7 use warnings;
  1         2  
  1         33  
4 1     1   6 use DBI;
  1         1  
  1         42  
5 1     1   5 use DBIx::SQLCrosstab;
  1         1  
  1         9656  
6              
7             our $VERSION = '0.7';
8             # 08-Jan-2004
9              
10             require 5.006001;
11              
12             require Exporter;
13             our @ISA= qw(DBIx::SQLCrosstab);
14             our @EXPORT=qw();
15             our @EXPORT_OK=qw();
16              
17             my %_html_colors = (
18             text => "#009900", # green
19             number => "#FF0000", # red
20             header => "#0000FF", # blue
21             footer => "#000099", # darkblue
22             );
23              
24             my %_table_params = (
25             border => 1,
26             cellspacing => 0,
27             cellpadding => 2
28             );
29              
30             sub _format {
31 772     772   1026 my $self = shift;
32 772         1071 my ($str, $what) = @_;
33 772 50 66     2784 return $str unless ($self->{add_colors} or $self->{commify});
34 772         2076 my $numeric = $str =~ /^[0-9.]+$/;
35              
36 772 100 100     2170 if (($what eq "data") or ($what eq "footer")) {
37 710 100 66     3098 if ( $self->{commify} && $numeric )
38             {
39 684 50       1490 if ($str =~ /\./) {
40 0         0 $str = sprintf("%.2f", $str);
41             }
42 684         2901 $str =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/,/g;
43             }
44             }
45 772 100       1940 if ($self->{add_colors} ) {
46 430         420 my $color_type;
47 430 100       930 $color_type = $what eq "data" ? $numeric ? "number": "text" : $what;
    100          
48 430         1040 $str = qq// . $str . "";
49             }
50 772         2431 return $str;
51             }
52              
53             sub _find_headers {
54 4     4   8 my $self = shift;
55 4 50       21 return seterr("can't create headers before fetching records ")
56             unless $self->{recs};
57 4         36 my $tree = Tree::DAG_Node->new;
58 4         265 $tree->name('xtab');
59              
60             # create headers tree
61 4         28 for my $name (@{$self->{NAME}}) {
  4         15  
62 84         117 my $top = $tree;
63 84         340 for my $lev ( split $self->{query_separator}, $name) {
64 176         196 my $node;
65 176         440 ($node) = grep {$_->name eq $lev} $top->daughters;
  372         2523  
66 176 100       1234 unless ($node) {
67 84         219 $node = Tree::DAG_Node-> new;
68 84         2408 $node->name($lev);
69             }
70 176         772 $top->add_daughter($node);
71 176         10135 $top = $node;
72             }
73             }
74              
75             # add subtotal headers
76             $tree->walk_down({
77             callback => sub {
78 128     128   6804 my $node = shift;
79 128 100       309 return 1 if $node->address eq "0";
80 124 100 66     6862 if ($node->descendants && $self->{col_sub_total}) {
81 40         3526 $node->new_daughter->name("total");
82             #$node->new_daughter->name("(". $node->name . ")");
83             }
84             }
85 4         41 });
86              
87             # find maximum depth
88 4         188 my $tree_depth = 0;
89             $tree->walk_down({
90             callback =>sub {
91 128     128   2710 my $node = shift;
92 128   100     273 my $depth = scalar $node->ancestors || 0;
93 128 100       1607 $tree_depth = $depth if $depth > $tree_depth;
94 128         267 1;
95             }
96 4         27 });
97              
98             # find initial columns without sublevels
99 4         76 my @header_columns =();
100             #@header_columns = map {$_->{alias}} @{$self->{rows}};
101              
102 4 50       16 if ($tree_depth> 1) {
103             $tree->walk_down({
104             callback => sub {
105 128     128   3529 my $node=shift;
106 128 100       320 return 1 if $node->address eq "0";
107 124 100       6669 if ($node->descendants) {
108 40         4710 $_[0]->{_end_hc} = 1;
109 40         98 return 1
110             }
111 84 100       2862 push @header_columns, $node->name
112             unless $_[0]->{_end_hc};
113 84         252 my $cur_depth = ($node->address =~ tr/://) -1;
114 84         4840 $node->attributes->{rowspan} = $tree_depth - $cur_depth ;
115             #print STDERR $node->name," ",
116             # $node->attributes->{rowspan},
117             # "\n";
118             },
119 4         81 _end_hc => 0
120             });
121             }
122             else {
123 0         0 my $recs_rows = $#{$self->{recs}};
  0         0  
124 0         0 COL:
125 0         0 for my $col ( 0.. $#{$self->{recs}->[0]} ) {
126 0         0 my $all_numeric =1;
127 0         0 for my $row( 0.. $recs_rows) {
128 0         0 my $value = $self->{recs}[$row][$col];
129 0 0       0 $value = 0 unless defined $value;
130 0 0       0 unless (($value =~ /^[0-9.]+$/))
131             {
132 0         0 push @header_columns,
133             ($tree->daughters)[$col]->name;
134 0         0 $all_numeric =0;
135 0         0 next COL;
136             }
137             }
138 0 0       0 last COL if $all_numeric;
139             }
140             }
141              
142             # create the record tree for the initial columns
143 4         116 my $tree_rec = Tree::DAG_Node->new;
144 4         192 $tree_rec->name('recs');
145 4         31 for my $rec (@{$self->{recs}}) {
  4         18  
146 36         48 my @cols;
147 36         87 for (0..$#header_columns) {
148 72         167 push @cols, $rec->[$_];
149             }
150 36         65 my $top = $tree_rec;
151 36         52 for my $lev ( @cols) {
152 72         86 my $node;
153 72         200 ($node) = grep {$_->name eq $lev} $top->daughters;
  88         606  
154 72 100       524 unless ($node) {
155 52         136 $node = Tree::DAG_Node-> new;
156 52         1557 $node->name($lev);
157             }
158 72         383 $top->add_daughter($node);
159 72         4006 $top = $node;
160             }
161             }
162              
163 4         12 my @header_formats =();
164              
165             # find column span values
166             $tree->walk_down( {
167             callbackback => sub {
168 128     128   4283 my $node = shift;
169 128 100       297 return 1 unless $node->mother;
170 124 100       850 $node->attributes->{colspan} = 1
171             unless ($node->descendants);
172 124         8011 $node->mother->attributes->{colspan}
173             += $node->attributes->{colspan};
174             }
175 4         39 });
176              
177             # insert values into header format array
178             $tree->walk_down({
179             callback => sub {
180 128     128   2877 my $node = shift;
181 128 100       300 return 1 if $node->address eq '0';
182 124         6659 my $level = $node->address =~ tr/://;
183 124         6329 $level--;
184 124         322 my %format = (
185             rowspan => 0,
186             colspan => $node->attributes->{colspan},
187             name => $node->name
188             );
189 124 100       1439 if (defined $node->attributes->{rowspan}) {
190 84         556 $format{rowspan} =
191             $node->attributes->{rowspan}
192             }
193 124         620 push @{$header_formats[$level]}, \%format;
  124         435  
194             }
195 4         94 });
196 4         104 $self->{header_formats} = \@header_formats;
197              
198 4         61 my %recs_formats =();
199              
200             # find row spans values for records
201             $tree_rec->walk_down( {
202             callbackback => sub {
203 56     56   1851 my $node = shift;
204 56 100       149 return 1 unless $node->mother;
205 52 100       365 $node->attributes->{rowspan} = 1
206             unless ($node->descendants);
207 52         2838 $node->mother->attributes->{rowspan}
208             += $node->attributes->{rowspan};
209             }
210 4         38 });
211              
212             # insert values into record format structure
213             $tree_rec->walk_down({
214             callback => sub {
215 56     56   1629 my $node = shift;
216 56 100       140 return 1 if $node->address eq '0';
217 52         2231 my $level = $node->address =~ tr/://;
218 52         2003 push @{$recs_formats{$level-1}{$node->name}},
  52         173  
219             $node->attributes->{rowspan};
220             }
221 4         76 });
222 4         123 $self->{header_tree} = $tree;
223 4         12 $self->{recs_tree} = $tree_rec;
224 4         15 $self->{recs_formats} = \%recs_formats;
225 4         134 return $self;
226             }
227              
228             sub html_header{
229 0     0 0 0 my $self=shift;
230 0         0 my $html_title = "XTAB";
231 0 0       0 if ($self->{title}) {
232 0         0 $html_title = $self->op_list
233             .$self->{title};
234             }
235             return
236 0         0 "\n\n"
237             ."$html_title\n"
238             . "\n"
239             ."\n";
240             }
241              
242             sub _strip_separator {
243 21     21   28 my $self = shift;
244 21         31 my $str = shift;
245 21         90 $str =~ s/$self->{query_separator}/ /g;
246 21         83 return $str;
247             }
248              
249             sub as_bare_html {
250 1     1 0 41 my $self = shift;
251 1 50       8 return DBIx::SQLCrosstab::seterr("can't create table before record fetching")
252             unless $self->{recs};
253 1         6 my $html = qq(\n); \n"; "; \n";
254             #my $html = qq(\n); "; \n"; "; " for @$rec; \n";
255 1         3 $html .= "
256 1         8 $html .= "". $self->_strip_separator($_).""
257 1         3 for @{$self->{NAME}};
258 1         3 $html .= "
259 1         3 for my $rec (@{$self->{recs}}) {
  1         4  
260 9         12 $html .= "
261 9 50       188 $html .= "". (defined $_ ? $_ : "-") . "
262 9         23 $html .= "
263             }
264 1         3 $html .= "
\n";
265 1         5 return $html;
266             }
267              
268              
269             sub as_html {
270 2     2 1 64 my $self=shift;
271 2 50       11 return DBIx::SQLCrosstab::seterr("can't create table before record fetching")
272             unless $self->{recs};
273 2         6 my $params =shift;
274 2 50       6 if ($params) {
275 0         0 for (qw(complete_html_page only_html_header
276             add_colors text_color number_color header_color
277             footer_color table_cellpadding table_cellspacing table_border))
278             {
279 0 0       0 if (exists $params->{$_})
280             {
281 0         0 $self->{$_} = $params->{$_};
282             }
283             }
284             }
285 2 50       9 return undef unless $self->_find_headers;
286 2 50       11 if ($self->{add_colors}) {
287 2         8 for (qw(text number header footer)) {
288 8 50       28 if (exists $self->{$_."_color"}) {
289 0         0 $_html_colors{$_} = $self->{$_."_color"};
290             }
291             }
292             }
293 2         6 for (qw(border cellpadding cellspacing)) {
294 6 50       19 if (exists $self->{"table_$_"}) {
295 0         0 $_table_params{$_} = $self->{"table_$_"}
296             }
297             }
298 2         5 my $html ="";
299 2 50       8 if ($self->{complete_html_page})
300             {
301 0         0 $html = $self->html_header;
302             }
303 2         15 $html .= qq(\n); \n"; \n"; \n";
304 2 50       9 if ($self->{title_in_header}) {
305 2         5 my $colspan1 = scalar @{$self->{NAME}};
  2         12  
306 2         11 $html .= "
$self->{title}
307             }
308 2         3 for my $h (@{$self->{header_formats}}) {
  2         6  
309 6         8 $html .= "
310 6         30 for my $col (@$h) {
311 62         71 my $rowspan = "";
312 62 50       130 if (defined $col->{rowspan} )
313             {
314 62         137 $rowspan = "rowspan=$col->{rowspan}";
315             }
316             $html .=
317 62         195 "{colspan}>"
318             . $self->_format($col->{name}, "header")
319             . "";
320             }
321 6         14 $html .= "\n
322             }
323 2 50       9 if ($self->{only_html_header}) {
324 0         0 $html .= "
\n";
325 0         0 return $html;
326             }
327              
328 2         3 for my $rec (@{$self->{recs}}) {
  2         6  
329 18         25 $html .= "
330 18         24 my $what = "data";
331 18 100 66     141 if ( $rec->[0]
      66        
332             && ($rec->[0] =~ /\bzz+\b/)
333             || ($rec->[0] eq 'total') ) {
334 2         5 $what = "footer";
335             }
336 18         44 for (0 .. $#$rec) {
337 378         526 my %attr =();
338 378 100 66     1287 if (defined ($self->{recs_formats}{$_})
339             && defined $self->{recs_formats}{$_}{$rec->[$_]})
340             {
341 36 100       35 if ( @{$self->{recs_formats}{ $_ }{ $rec->[$_] }} )
  36         118  
342             {
343 26         83 $attr{rowspan} = shift
344 26         28 @{$self->{recs_formats}{$_}{$rec->[$_]}};
345             }
346             else {
347 10         24 next;
348             }
349             }
350             #$rec->[$_] = "" unless defined $rec->[$_];
351 368 100 66     2206 if ( defined($rec->[$_]) && ($rec->[$_] =~ /^[0-9.]+$/)) {
352 342         602 $attr{align} = "right";
353             }
354 368         1209 my $td = "
355 368         640 . (join(" ",map( { qq/ $_="$attr{$_}"/} keys %attr)))
356             . ">";
357 368 50       1241 $html .= $td
358             . $self->_format( defined $rec->[$_] ?
359             $rec->[$_] : "-", $what )
360             ."
361             }
362 18         41 $html .= "\n
363             }
364 2         5 $html .= "
\n";
365 2 50       11 if ($self->{complete_html_page}) {
366 0         0 $html .= $self->html_footer;
367             }
368 2         62 return $html;
369             }
370              
371             sub html_footer {
372 0     0 0 0 my $self = shift;
373 0         0 return "\n"
374             ."\n";
375             }
376              
377             sub as_xml {
378 2     2 1 47 my $self = shift;
379 2         5 my $tab = " ";
380 2 50       10 return undef unless $self->_find_headers;
381 2         14 local $self->{add_colors} = 0;
382 2         7 my $xml = qq/\n/;
383 2   50     12 my $title = $self->{title} || "Crosstab";
384 2         13 $title =~ s/&/&/g;
385 2         5 $title =~ s/
386 2         5 $title =~ s/>/>/g;
387 2         17 $xml .= qq/
388             . qq/generator="/ . ref($self) . qq/ version $VERSION">\n/;
389              
390             # attach database column labels to header descriptors
391             $self->{recs_tree}->walk_down ({
392             callback => sub {
393 28     28   584 my $n = shift;
394 28 100       68 return 1 unless $n->mother;
395 26         204 $n->attributes->{label} =
396             $self->{NAME}->[$_[0]->{_depth}-1];
397 26         154 1;
398             },
399 2         39 _depth=>0,
400             });
401              
402             # attach database column labels to record descriptors
403             $self->{header_tree}->walk_down ({
404             callback => sub {
405 64     64   1344 my $n = shift;
406 64 100       148 return 1 unless $n->mother;
407 62 100       522 my $label = $self->{cols}->[$_[0]->{_depth}-1]->{value}?
408             $self->{cols}->[$_[0]->{_depth}-1]->{value} :
409             $self->{cols}->[$_[0]->{_depth}-1]->{id};
410 62         149 $n->attributes->{label} = $label;
411 62         358 1;
412             },
413 2         57 _depth=>0,
414             });
415              
416             # start producing XML output
417             # processing records row by row
418              
419 2         40 my @records = map {[@$_]} @{$self->{recs}};
  18         148  
  2         8  
420             $self->{recs_tree}->walk_down ({
421             callback => sub {
422 28     28   1228 my $n = shift;
423 28 100       86 return 1 unless $n->mother;
424 26 100       201 if ($n->name eq 'zzzz') {
425 10         92 $n->name('total');
426             }
427 26         197 $xml .= $tab x $_[0]->{_depth};
428 26         79 $xml .= "<"
429             . $n->attributes->{label}
430             . " name="
431             . '"'
432             . $n->name
433             . '"'
434             . ">\n";
435 26 100       289 return 1 if $n->descendants;
436             #
437             # for each row, a tree of its contents
438             # based on the header description
439             # is produced
440 18         719 $xml = $self->_make_xml_line($_[0]->{_depth},
441             $xml, shift @records, $tab);
442 18         76 1;
443             },
444             callbackback => sub {
445 28     28   378 my $n = shift;
446 28 100       76 return 1 unless $n->mother;
447 26         252 $xml .= $tab x $_[0]->{_depth};
448 26         71 $xml .= "
449             . $n->attributes->{label}
450             . ">\n";
451 26         186 1;
452             },
453 2         29 _depth => 0,
454             });
455 2         43 $xml .= "";
456 2         38 $xml =~ s{<(\w+)>}{<$1/>}g;
457 2         47 $xml =~ s{<(\w+)(\s*\S*)>(?:\s*<\w+/>\s*)+}{<$1$2/>}sg;
458 2         42 return $xml;
459             }
460              
461             sub _make_xml_line {
462 18     18   34 my $self = shift;
463 18         33 my $depth = shift;
464 18         40 my $xml = shift;
465 18         37 my $line = shift;
466 18         36 my $tab = shift;
467 18         36 my $skip = $depth; # columns to skip in callback
468 18         32 my $skipb = $depth; # columns to skip in callbackback
469 18         273 for (1..$skip) {
470 36         97 shift @$line;
471             }
472             $self->{header_tree}->walk_down({
473             callback => sub {
474 576     576   10699 my $n = shift;
475 576 100       1859 return 1 unless $n->mother;
476 558 100       4186 return 1 if $skip-- > 0;
477 522         1214 $xml .= $tab x $_[0]->{_depth};
478 522 100       1381 if ($n->descendants) {
479 180         37366 $xml .= "<"
480             . $n->attributes->{label}
481             . ' name="'
482             . $n->name
483             . '">'
484             . "\n";
485 180         1978 $_[0]->{_label} = 1;
486 180         433 return 1;
487             }
488             else {
489 342         17494 $xml .= " <"
490             . $n->name
491             . ">";
492 342         2249 $_[0]->{_label} = 0;
493             }
494 342         624 my $value = shift @$line;
495 342 100       741 if ($value) {
496 156         285 $value =~ s/zzzz/total/;
497             }
498 342 50       1137 $xml .= ""
499             . (defined $value? $self->_format($value,"data") : "")
500             . "";
501 342         1103 $_[0]->{_blanks} =0;
502             },
503             callbackback => sub {
504 576     576   6592 my $n = shift;
505 576 100       4840 return 1 unless $n->mother;
506 558 100       4353 return 1 if $skipb-- > 0;
507 522 100       1213 if ($_[0]->{_blanks} ) {
508 180         415 $xml .= $tab x $_[0]->{_depth};
509             }
510             else {
511 342         828 $_[0]->{_blanks} = 1;
512             }
513 522 100 66     2319 if ($_[0]->{_label} or ($n->descendants)) {
514 180         34928 $xml .= "attributes->{label} . ">\n"
515             }
516             else {
517 342         20422 $xml .= "name . ">\n";
518             }
519 522         11723 1;
520             },
521 18         276 _depth => $depth,
522             _blanks =>1,
523             _label => 1,
524             });
525 18         787 return $xml;
526             }
527              
528             sub as_xls {
529 0     0 1 0 my $self = shift;
530 0 0       0 my $fname = shift
531             or return DBIx::SQLCrosstab::seterr("File name required to create spreadsheet");
532 0   0     0 my $mode = shift || 'straight';
533 0         0 $mode =~ s/\s*//g;
534 0         0 my %books = (
535             straight => $mode =~ /^(?:straight|both)$/i,
536             transpose => $mode =~ /^(?:transpose|both)$/i
537             );
538 0         0 eval {require Spreadsheet::WriteExcel};
  0         0  
539 0 0       0 if ($@) {
540 0         0 return DBIx::SQLCrosstab::seterr("required module Spreadsheet::WriteExcel not found");
541             }
542 0 0       0 return DBIx::SQLCrosstab::seterr("Recordset not found. Execute query first")
543             unless $self->{recs};
544 0 0       0 my $workbook = Spreadsheet::WriteExcel->new($fname)
545             or return DBIx::SQLCrosstab::seterr("Error creating spreadsheet");
546 0         0 my $format = $workbook->add_format(); # Add a format
547 0         0 $format->set_bold();
548 0         0 $format->set_text_wrap();
549 0         0 $format->set_color('blue');
550 0         0 $format->set_align('center');
551 0 0       0 if ($books{straight}) {
552 0         0 my $worksheet = $workbook->add_worksheet("Crosstab");
553 0         0 $worksheet->write('A1',[map {
554 0         0 join " ", split /$self->{query_separator}/, $_}
555 0         0 @{$self->{NAME}}], $format);
556 0         0 my $row = 2;
557 0         0 $worksheet->write('A'. ($row++), $_ ) for @{$self->{recs}};
  0         0  
558             }
559 0 0       0 if ($books{transpose}) {
560 0         0 my $worksheet = $workbook->add_worksheet("Transposed");
561 0         0 my $row =1;
562 0         0 $format->set_text_wrap(0);
563 0         0 $format->set_align('left');
564 0         0 $worksheet->write('A' . ($row++), $_ , $format) for
  0         0  
565 0         0 map {join " ", split /$self->{query_separator}/, $_}
566             @{$self->{NAME}};
567 0         0 $worksheet->write('B1', $self->{recs});
568             }
569 0         0 $workbook->close();
570 0         0 return $workbook;
571             }
572              
573             sub as_perl_struct {
574 5     5 1 254 my $self = shift;
575 5   50     24 my $struct = shift || 'lol';
576 5 50 33     51 return DBIx::SQLCrosstab::seterr("no records to process")
577             unless $self->{recs} and $self->{NAME};
578 5         27 my %structs = (
579             lol => undef, # list of lists
580             loh => undef, # list of hashes (tree-like)
581             losh => undef, # list of simple hashes
582             hoh => undef # hash of hashes
583             );
584 5 50       18 return DBIx::SQLCrosstab::seterr ("unrecognized structure $struct")
585             unless exists $structs{$struct};
586 5 100       19 if ($struct eq 'lol') {
587 1         5 return $self->{recs};
588             }
589 4         8 my $depth = 1;
590 84         369 my @splitnames = map {[split /$self->{query_separator}/,$_]}
  4         17  
591 4         10 @{$self->{NAME}};
592              
593 4         19 for (@splitnames) {
594 84 100       169 $depth = @$_ if (@$_ > $depth);
595             }
596 4         12 for (@splitnames) {
597 84         159 while (@$_ < $depth) {
598 76         194 push @$_, '-';
599             }
600             }
601 4         7 my $rowheaders = @{$self->{rows}};
  4         16  
602 4         8 my %hoh =();
603 4         10 for my $row (@{$self->{recs}}) {
  4         17  
604 36 100       74 if ($struct eq 'losh') {
605 9         14 my %rec=();
606 9         16 @rec{@{$self->{NAME}}} = @$row;
  9         127  
607 9         20 push @{$structs{losh}}, \%rec;
  9         88  
608             }
609             else {
610 27         29 my %rec;
611 27         33 my $count = 0;
612 27         33 my $rh ="";
613 27         56 for my $col (@$row) {
614 567         815 my $value = $col;
615 567 50       1240 $value = "" unless defined $value;
616 567         772 $value =~ s/zzzz/total/;
617 567 100       886 if ($count < $rowheaders) {
618 54         81 $rh .= "{$value}";
619             }
620             else {
621 1539         5512 my $key = join "", map {"{$_}"}
  513         1042  
622 513         511 @{$splitnames[$count]};
623             #print qq/\$rec$rh - $key = $col\n/;
624 513 100       1549 if ($struct eq 'loh') {
    50          
625 171         7637 eval qq/\$rec$rh$key = $value/;
626             }
627             elsif($struct eq 'hoh') {
628 342         17486 eval qq/\$structs{hoh}{xtab}$rh$key = $value/;
629             }
630             }
631 567         1990 $count++;
632             }
633 27 100       114 push @{$structs{loh}}, \%rec if $struct eq 'loh';
  9         40  
634             }
635             }
636 4         62 return $structs{$struct};
637             }
638              
639             sub as_csv {
640 0     0 1   my $self = shift;
641 0           my $wantheader = shift;
642 0 0 0       return DBIx::SQLCrosstab::seterr("no records to process")
643             unless $self->{recs} and $self->{NAME};
644 0           my $csv ="";
645 0 0         if ($wantheader) {
646 0           $csv .= join ",", map {_quote($_)}
  0            
647 0           @{$self->{NAME}};
648 0           $csv .= "\n";
649             }
650 0           for my $row (@{$self->{recs}}) {
  0            
651 0 0         $csv .= join ",", map {
    0          
652 0           defined $_ and /^[0-9.]+$/ ? $_ : _quote($_)
653             } @$row;
654 0           $csv .= "\n";
655             }
656 0           return $csv;
657             }
658              
659             sub as_yaml {
660 0     0 1   my $self = shift;
661 0 0 0       return DBIx::SQLCrosstab::seterr("no records to process")
662             unless $self->{recs} and $self->{NAME};
663 0           eval {require YAML};
  0            
664 0 0         if ($@){
665 0           return DBIx::SQLCrosstab::seterr('required module YAML not found');
666             }
667 0           return YAML::Dump($self->as_perl_struct('hoh'));
668             }
669              
670             sub _quote {
671 0     0     my $str = shift;
672 0 0         $str =~ s/\"/\\\"/g if $str;
673 0 0         return defined $str ? '"'.$str.'"' : '""' ;
674             }
675              
676             1;
677             __END__