File Coverage

blib/lib/Net/Amazon/MechanicalTurk/DelimitedReader.pm
Criterion Covered Total %
statement 80 84 95.2
branch 34 42 80.9
condition 3 3 100.0
subroutine 9 9 100.0
pod 0 3 0.0
total 126 141 89.3


line stmt bran cond sub pod time code
1             package Net::Amazon::MechanicalTurk::DelimitedReader;
2 3     3   19540 use strict;
  3         8  
  3         98  
3 3     3   14 use warnings;
  3         6  
  3         75  
4 3     3   847 use IO::File;
  3         9635  
  3         513  
5 3     3   16 use Carp;
  3         5  
  3         141  
6 3     3   535 use Net::Amazon::MechanicalTurk::BaseObject;
  3         5  
  3         1954  
7              
8             our $VERSION = '1.00';
9              
10             our @ISA = qw{ Net::Amazon::MechanicalTurk::BaseObject };
11              
12             Net::Amazon::MechanicalTurk::DelimitedReader->attributes(qw{
13             fieldSeparator
14             input
15             file
16             utf8
17             autoclose
18             });
19              
20             # The following CPAN modules do not support new lines in a column:
21             # (So I wrote this class)
22             # Text::CSV
23             # Text::CSV_XS
24             # Text::CSV_PP
25              
26             sub init {
27 4     4 0 11 my $self = shift;
28 4         35 $self->setAttributes(@_);
29 4         32 $self->setAttributesIfNotDefined(
30             fieldSeparator => ',',
31             utf8 => 1,
32             autoclose => 0
33             );
34 4         28 $self->assertRequiredAttributes(qw{
35             fieldSeparator
36             });
37 4 50       25 if (!defined $self->input) {
38 4 50       16 if (!defined $self->file) {
39 0         0 Carp::croak("Either input or file must be specified.");
40             }
41 4         15 my $in = IO::File->new($self->file, "r");
42 4 50       608 if (!$in) {
43 0         0 Carp::croak("Couldn't open " . $self->file . " - $!.");
44             }
45 4 50       15 if ($self->utf8) {
46             # By using utf8 these modules should be able to handle
47             # non-english answers with recent versions of perl.
48 4         16 eval { binmode($in, ":utf8") };
  4         24  
49 4 50       22 warn "Couldn't set filehandle to utf8." if $@;
50             }
51 4         17 $self->autoclose(1);
52 4         14 $self->input($in);
53             }
54             else {
55 0         0 $self->file(sprintf "%s", $self->input);
56             }
57             }
58              
59             sub DESTROY {
60 4     4   4711 my $self = shift;
61 4 50       16 if ($self->autoclose) {
62 4         14 $self->close;
63             }
64             }
65              
66             sub close {
67 8     8 0 15 my $self = shift;
68 8 100       25 if ($self->input) {
69 4         15 $self->input->close;
70 4         103 $self->input(undef);
71             }
72             }
73              
74             sub next {
75 47     47 0 180 my $self = shift;
76 47         245 my $in = $self->input;
77 47         156 my $fs = $self->fieldSeparator;
78 47         83 my $row = [];
79 47         80 my $lastWasQuote = 0;
80 47         105 my $quotedCell = 0;
81 47         63 my $cell = '';
82            
83 47 100       139 return undef unless $self->input;
84            
85 43         78 while (1) {
86 338         704 my $c = getc($in);
87              
88             # Handle end of input
89 338 100       691 if (!defined($c)) {
90 4         14 push(@$row, $cell);
91 4         15 $self->close;
92 4         19 $self->input(undef);
93 4         28 return $row;
94             }
95            
96 334 50       700 next if ($c eq "\r"); # just throw away \r
97            
98 334 100       498 if ($quotedCell) {
99 128 100       364 if ($c eq "\n") {
    100          
    100          
100 8 100       23 if ($lastWasQuote) {
101 2         11 push(@$row, $cell);
102 2         9 return $row;
103             }
104 6         11 $cell .= "\n";
105 6         14 $lastWasQuote = 0;
106             }
107             elsif ($c eq $fs) {
108 9 100       20 if ($lastWasQuote) {
109 6         15 push(@$row, $cell);
110 6         10 $cell = '';
111 6         9 $lastWasQuote = 0;
112 6         10 $quotedCell = 0;
113             }
114             else {
115 3         7 $cell .= $c;
116 3         5 $lastWasQuote = 0;
117             }
118             }
119             elsif ($c eq '"') {
120 20 100       39 if ($lastWasQuote) {
121 6         10 $cell .= $c;
122 6         9 $lastWasQuote = 0;
123             }
124             else {
125 14         21 $lastWasQuote = 1;
126             }
127             }
128             else {
129 91 50       202 if ($lastWasQuote) {
130 0         0 warn "Single quote found in cell which was not escaped.\n";
131             }
132 91         142 $cell .= $c;
133 91         136 $lastWasQuote = 0;
134             }
135             }
136             else {
137 206 100 100     851 if ($cell eq '' and $c eq '"') {
    100          
    100          
138 8         15 $quotedCell = 1;
139             }
140             elsif ($c eq "\n") {
141 37         82 push(@$row, $cell);
142 37         149 return $row;
143             }
144             elsif ($c eq $fs) {
145 20         53 push(@$row, $cell);
146 20         30 $cell = '';
147             }
148             else {
149 141         199 $cell .= $c;
150             }
151             }
152             }
153             }
154              
155             return 1;