File Coverage

blib/lib/Tie/Array/FileWriter.pm

Criterion	Covered	Total	%
statement	36	60	60.0
branch	7	16	43.7
condition			n/a
subroutine	9	20	45.0
pod			n/a
total	52	96	54.1

package Tie::Array::FileWriter;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.1';

use FileHandle;
use Carp;


#
# TIEARRAY()
#

sub TIEARRAY
{
  my ($class, $file, $fdelim, $rdelim) = @_;

  $fdelim = "|"  unless defined $fdelim;
  $rdelim = "\n" unless defined $rdelim;

  my $fh;
  my $close_it;

  if (ref $file eq 'FileHandle') {
    croak "FileHandle is not open for writing!"
      unless $fh->opened;

    $fh       = $file;
    $close_it = 0;
  } else {
    $fh       = FileHandle->new(">$file");

    croak "Unable to open file '$file' for writing: $!"
      unless defined $fh;

    $close_it = 1;
  }

  return bless {
    FH       => $fh,
    CLOSE_IT => $close_it,
    FDELIM   => $fdelim,
    RDELIM   => $rdelim
  }, $class;
}


#
# PUSH()
#

sub PUSH
{
  my $self   = shift;
  my $fh     = $self->{FH};
  my $fdelim = $self->{FDELIM};
  my $rdelim = $self->{RDELIM};

  foreach my $elem (@_) {
    next unless defined $elem;
    next unless ref $elem eq 'ARRAY';
    print($fh join($fdelim, @$elem), $rdelim);
  }
}


#
# UNTIE():
#

sub UNTIE
{
  my $self = shift;
  $self->{FH}->close;
}


#
# FETCHSIZE()
#
# Pushing elements calls FETCHSIZE().
#

sub FETCHSIZE
{
  return 0;
}


#
# UNIMPLEMENTED FUNCTIONS:
#

sub CLEAR     { my $self = shift; croak("No CLEAR in "     . ref $self) }
sub DELETE    { my $self = shift; croak("No DELETE in "    . ref $self) }
sub EXISTS    { my $self = shift; croak("No EXISTS in "    . ref $self) }
sub EXTEND    { my $self = shift; croak("No EXTEND in "    . ref $self) }
sub FETCH     { my $self = shift; croak("No FETCH in "     . ref $self) }
sub POP       { my $self = shift; croak("No POP in "       . ref $self) }
sub SPLICE    { my $self = shift; croak("No SPLICE in "    . ref $self) }
sub SHIFT     { my $self = shift; croak("No SHIFT in "     . ref $self) }
sub STORE     { my $self = shift; croak("No STORE in "     . ref $self) }
sub STORESIZE { my $self = shift; croak("No STORESIZE in " . ref $self) unless shift == 0 }
sub UNSHIFT   { my $self = shift; croak("No UNSHIFT in "   . ref $self) }

1;
__END__