File Coverage

blib/lib/Data/All/IO/Base.pm

Criterion	Covered	Total	%
statement	55	60	91.6
branch	7	12	58.3
condition	1	3	33.3
subroutine	13	14	92.8
pod	0	6	0.0
total	76	95	80.0

package Data::All::IO::Base;

#   Base package for all format modules

#   $Id: Base.pm,v 1.1.1.1 2005/05/10 23:56:20 dmandelbaum Exp $

use strict;
use warnings;


use Data::All::Base;
use Data::All::Format;

our $VERSION = 0.13;

use base 'Exporter';
our @EXPORT = qw(new internal attribute populate error init	_load_format
				 getrecords putrecords array_to_hash hash_to_array getrecord_hash
				_add_field
	);

#   Interface
sub count();
sub array_to_hash(\@);




sub _add_field()
{
    my ($self, $name) = @_;

    return if (defined($self->__added_fields()->{'_ORGINAL'}));

    unshift(@{ $self->fields() }, '_ORIGINAL');
    $self->__added_fields()->{'_ORGINAL'}++;
}

sub array_to_hash(\@)
{
    my ($self, $record) = @_;
    my %hash;

    $self->_add_field('_ORIGINAL') if ($self->ioconf->{'with_original'});

    my @fields = @{ $self->fields() };
    @hash{ @fields } = @{ $record };

    return \%hash;
}

sub hash_to_array()
{
    my ($self, $hash) = @_;
    return [@{ $hash }{@{ $self->fields() }}];
}


sub getrecord_hash()
{
    my $self = shift;
    my $rec = $self->getrecord_array($self->ioconf->{'with_original'});

    return ($rec)
        ?  $self->array_to_hash($rec)
        : undef;
}

sub getrecords(;$$)
{
    my $self = shift;
    #   TODO:   Enable running COUNT records only

    my (@records);

    #warn ' -> using fields:', join(',', @{ $self->fields });

    while (my $record = $self->getrecord_hash())
    {
        push(@records, $record);
    }

    return wantarray ? @records : \@records;
}



sub putrecords()
{
    my $self = shift;
    my ($records, $options) = @_;

    my $start = 0;
    my $count = $#{ $records }+1;

    die("$self->putrecords() needs records") unless ($#{ $records }+1);

    #warn "Writing $count records from $start";

    my $record;
    while ($count--)
    {
        $self->putrecord($records->[ $start++ ], $options);
    }
}


sub _load_format()
{
    my $self = shift;
    my $format = shift || $self->format();

    return Data::All::Format->new($format->{'type'}, $format);
}


sub init()
#   Called in Data::All::IO::new
#   TODO: Create Format::Hash
{
    my ($self, $args) = @_;
    use Data::Dumper;

    populate $self => $args;

    $self->__FORMAT($self->_load_format())
        #   Override the loading of a Format reader for Hash types
        unless ($self->ioconf()->{'type'} eq 'db');

    return $self;
}


1;