File Coverage

blib/lib/EB/Report/Reporter/Csv.pm
Criterion Covered Total %
statement 12 44 27.2
branch 0 10 0.0
condition 0 8 0.0
subroutine 4 9 44.4
pod 0 4 0.0
total 16 75 21.3


line stmt bran cond sub pod time code
1             #! perl
2              
3             # Csv.pm -- Reporter backend for CSV reports.
4             # Author : Johan Vromans
5             # Created On : Thu Jan 5 18:47:37 2006
6             # Last Modified By: Johan Vromans
7             # Last Modified On: Sat Jun 19 00:39:24 2010
8             # Update Count : 16
9             # Status : Unknown, Use with caution!
10              
11             package main;
12              
13             our $cfg;
14             our $dbh;
15              
16             package EB::Report::Reporter::Csv;
17              
18 1     1   5 use strict;
  1         0  
  1         22  
19 1     1   3 use warnings;
  1         1  
  1         18  
20              
21 1     1   3 use EB;
  1         1  
  1         211  
22              
23 1     1   5 use base qw(EB::Report::Reporter);
  1         1  
  1         368  
24              
25             ################ API ################
26              
27             sub start {
28 0     0 0   my ($self, @args) = @_;
29 0           $self->SUPER::start(@args);
30             }
31              
32             sub finish {
33 0     0 0   my ($self) = @_;
34 0           $self->SUPER::finish();
35 0           close($self->{fh});
36             }
37              
38             my $sep;
39              
40             sub add {
41 0     0 0   my ($self, $data) = @_;
42              
43 0           my $style = delete($data->{_style});
44              
45 0           $self->SUPER::add($data);
46              
47 0 0         return unless %$data;
48              
49 0   0       $sep = $self->{_sep} ||= $cfg->val(qw(csv separator), ",");
50              
51 0           $self->_checkhdr;
52              
53 0           my $line;
54              
55 0           foreach my $col ( @{$self->{_fields}} ) {
  0            
56 0           my $fname = $col->{name};
57 0 0         my $value = defined($data->{$fname}) ? _csv($data->{$fname}) : "";
58 0 0         $line .= $sep if defined($line);
59 0           $line .= $value;
60             }
61              
62 0           print {$self->{fh}} ($line, "\n");
  0            
63             }
64              
65             ################ Pseudo-Internal (used by Base class) ################
66              
67             sub header {
68 0     0 0   my ($self) = @_;
69 0 0         if ( grep { $_->{title} =~ /\S/ } @{$self->{_fields}} ) {
  0            
  0            
70 0           print {$self->{fh}} (join($sep,
71 0   0       map { _csv($_->{title}||"") }
72 0           @{$self->{_fields}}), "\n");
  0            
73             }
74             }
75              
76             ################ Internal methods ################
77              
78             sub _csv {
79 0     0     my ($value) = @_;
80             # Quotes must be doubled.
81 0           $value =~ s/"/""/g;
82             # Quote if anything non-simple.
83 0 0 0       $value = '"' . $value . '"'
84             if $value =~ /\s|\Q$sep\E|"/
85             || $value !~ /^[+-]?\d+([.,]\d+)?/;
86              
87 0           return $value;
88             }
89              
90             1;