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;