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

package Net::Amazon::MechanicalTurk::DelimitedWriter;
use strict;
use warnings;
use IO::File;
use Carp;
use Net::Amazon::MechanicalTurk::BaseObject;

our $VERSION = '1.00';

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;