package Net::Amazon::MechanicalTurk::DelimitedWriter; use strict; use warnings; use IO::File; use Carp; use Net::Amazon::MechanicalTurk::BaseObject; our $VERSION = '1.01_01'; our @ISA = qw{ Net::Amazon::MechanicalTurk::BaseObject }; Net::Amazon::MechanicalTurk::DelimitedWriter->attributes(qw{ fieldSeparator output file append lazy utf8 rowsWritten autoflush autoclose }); sub init { my $self = shift; $self->setAttributes(@_); $self->setAttributesIfNotDefined( fieldSeparator => ',', utf8 => 1, lazy => 0, append => 0, autoflush => 0, autoclose => 0 ); if (!defined $self->output) { if (!defined $self->file) { Carp::croak("Either output or file must be specified."); } if (!$self->lazy) { $self->open; } } else { $self->output->autoflush(1) if $self->autoflush; } $self->rowsWritten(0); } sub DESTROY { my $self = shift; if ($self->autoclose) { $self->close; } elsif ($self->output) { $self->output->flush; } } sub close { my $self = shift; if ($self->output) { $self->output->close; $self->output(undef); } } sub open { my $self = shift; if (defined $self->output) { return $self->output; } else { my $mode = ($self->append) ? "a" : "w"; my $out = IO::File->new($self->file, $mode); if (!$out) { Carp::croak("Couldn't open " . $self->file . " - $!."); } if ($self->utf8) { # By using utf8 these modules should be able to handle # non-english answers with recent versions of perl. eval { binmode($out, ":utf8") }; warn "Couldn't set filehandle to utf8." if $@; } $out->autoflush(1) if $self->autoflush; $self->output($out); $self->autoclose(1); return $out; } } sub write { my $self = shift; my $row = ($#_ == 0 and UNIVERSAL::isa($_[0], "ARRAY")) ? $_[0] : [@_]; my $out = $self->open; my $rowsWritten = $self->rowsWritten; if ($rowsWritten > 0) { print $out "\n"; } my $fs = $self->fieldSeparator; for (my $i=0; $i<=$#{$row}; $i++) { if ($i > 0) { print $out $fs; } print $out $self->formatCell($row->[$i]); } $self->rowsWritten($rowsWritten+1); } sub formatCell { my ($self, $cell) = @_; my $fs = $self->fieldSeparator; if (!defined $cell) { return ''; } if (index($cell, $fs) >= 0 or $cell =~ /[\n"]/s) { $cell =~ s/"/""/gs; return '"' . $cell . '"'; } else { return $cell; } } return 1;