File Coverage

blib/lib/Net/Amazon/MechanicalTurk/DelimitedWriter.pm
Criterion Covered Total %
statement 64 69 92.7
branch 22 36 61.1
condition 6 6 100.0
subroutine 11 11 100.0
pod 0 5 0.0
total 103 127 81.1


line stmt bran cond sub pod time code
1             package Net::Amazon::MechanicalTurk::DelimitedWriter;
2 3     3   21579 use strict;
  3         6  
  3         101  
3 3     3   16 use warnings;
  3         6  
  3         75  
4 3     3   740 use IO::File;
  3         9578  
  3         530  
5 3     3   21 use Carp;
  3         13  
  3         172  
6 3     3   560 use Net::Amazon::MechanicalTurk::BaseObject;
  3         6  
  3         2351  
7              
8             our $VERSION = '1.00';
9              
10             our @ISA = qw{ Net::Amazon::MechanicalTurk::BaseObject };
11              
12             Net::Amazon::MechanicalTurk::DelimitedWriter->attributes(qw{
13             fieldSeparator
14             output
15             file
16             append
17             lazy
18             utf8
19             rowsWritten
20             autoflush
21             autoclose
22             });
23              
24             sub init {
25 2     2 0 3 my $self = shift;
26 2         12 $self->setAttributes(@_);
27 2         12 $self->setAttributesIfNotDefined(
28             fieldSeparator => ',',
29             utf8 => 1,
30             lazy => 0,
31             append => 0,
32             autoflush => 0,
33             autoclose => 0
34             );
35 2 50       7 if (!defined $self->output) {
36 2 50       5 if (!defined $self->file) {
37 0         0 Carp::croak("Either output or file must be specified.");
38             }
39 2 50       7 if (!$self->lazy) {
40 2         6 $self->open;
41             }
42             }
43             else {
44 0 0       0 $self->output->autoflush(1) if $self->autoflush;
45             }
46 2         6 $self->rowsWritten(0);
47             }
48              
49             sub DESTROY {
50 2     2   1726 my $self = shift;
51 2 50       8 if ($self->autoclose) {
    0          
52 2         6 $self->close;
53             }
54             elsif ($self->output) {
55 0         0 $self->output->flush;
56             }
57             }
58              
59             sub close {
60 4     4 0 10 my $self = shift;
61 4 100       9 if ($self->output) {
62 2         5 $self->output->close;
63 2         99 $self->output(undef);
64             }
65             }
66              
67             sub open {
68 16     16 0 17 my $self = shift;
69 16 100       32 if (defined $self->output) {
70 14         30 return $self->output;
71             }
72             else {
73 2 50       5 my $mode = ($self->append) ? "a" : "w";
74 2         6 my $out = IO::File->new($self->file, $mode);
75 2 50       316 if (!$out) {
76 0         0 Carp::croak("Couldn't open " . $self->file . " - $!.");
77             }
78 2 50       6 if ($self->utf8) {
79             # By using utf8 these modules should be able to handle
80             # non-english answers with recent versions of perl.
81 2         3 eval { binmode($out, ":utf8") };
  2         16  
82 2 50       6 warn "Couldn't set filehandle to utf8." if $@;
83             }
84 2 50       5 $out->autoflush(1) if $self->autoflush;
85 2         6 $self->output($out);
86 2         5 $self->autoclose(1);
87 2         5 return $out;
88             }
89             }
90              
91             sub write {
92 14     14 0 50 my $self = shift;
93 14 100 100     55 my $row = ($#_ == 0 and UNIVERSAL::isa($_[0], "ARRAY")) ? $_[0] : [@_];
94 14         28 my $out = $self->open;
95 14         32 my $rowsWritten = $self->rowsWritten;
96 14 100       26 if ($rowsWritten > 0) {
97 12         22 print $out "\n";
98             }
99 14         30 my $fs = $self->fieldSeparator;
100 14         18 for (my $i=0; $i<=$#{$row}; $i++) {
  46         95  
101 32 100       48 if ($i > 0) {
102 20         33 print $out $fs;
103             }
104 32         55 print $out $self->formatCell($row->[$i]);
105             }
106 14         40 $self->rowsWritten($rowsWritten+1);
107             }
108              
109             sub formatCell {
110 32     32 0 35 my ($self, $cell) = @_;
111 32         63 my $fs = $self->fieldSeparator;
112 32 50       66 if (!defined $cell) {
113 0         0 return '';
114             }
115 32 100 100     128 if (index($cell, $fs) >= 0 or $cell =~ /[\n"]/s) {
116 7         14 $cell =~ s/"/""/gs;
117 7         23 return '"' . $cell . '"';
118             }
119             else {
120 25         83 return $cell;
121             }
122             }
123              
124             return 1;