File Coverage

blib/lib/Data/All.pm

Criterion	Covered	Total	%
statement	99	150	66.0
branch	26	48	54.1
condition	5	30	16.6
subroutine	17	27	62.9
pod	0	17	0.0
total	147	272	54.0

package Data::All;

#   Data::All - Access to data in many formats source many places

#   TODO: Create Data::All::IO::Hash for internal storage
#   TODO: Add checking for output field names that aren't present in input field names
#   TODO: Auto reset file/db cursors? Call read() then convert() causes error;

use strict;
use warnings;
#use diagnostics;

use Data::Dumper;
use Data::All::Base;
use Data::All::IO;

our $VERSION = 0.042;
our @EXPORT = qw(collection);

##  PUBLIC INTERFACE
sub show_fields;    #   returns an arrayref of field names
sub collection;     #   A shortcut for open() and read()
sub getrecord;
sub putrecord;
sub is_open;
sub convert;        #   Change formats
sub store;          #   save in memory records
sub count;          #   Record count
sub close;
sub read;
sub open;

##  PUBLIC ATTRIBUTES
##  i.e. $da->source()
attribute           'source';
attribute           'target';
attribute     'print_fields' => 0;
attribute           'atomic' => 1;


##  PRIVATE ATTRIBUTES

#   Contains Data::All::IO::* object by moniker
internal 'collection'        => {};

internal 'profile'     =>
#   Hardcoded/commonly used format configs
{
    csv     => ['delim', "\n", ',', '"', '\\'],
    tab     => ['delim', "\n", "\t", '', '']
};

internal 'a2h_template'  =>
#   Templates for converting arrayref configurations to
#   internally used, easy to handle hashref configs. See _parse_args().
#   TODO: move this functionality into a generic arg parsing library
{
    'format.delim'      => ['type','break','delim','quote','escape'],
    'format.fixed'      => ['type','break','lengths'],
    'ioconf.file'       => ['type','perm','with_original'],
    'ioconf.ftp'        => ['type','perm','with_original'],
    'ioconf.db'         => ['type','perm','with_original']
};

internal 'default'     =>
#   Default values for configuration variables
{
    profile => 'csv',
    filters => '',
    ioconf  =>
    {
        type    => 'file',
        perm    => 'r',
        with_original => 0
    },
    format =>
    {
        type    => 'delim'
    }
};


BEGIN {
    Data::All::IO->register_factory_type(  file => 'Data::All::IO::File');
    #Data::All::IO->register_factory_type(   xml => 'Data::All::IO::XML');
    Data::All::IO->register_factory_type(    db => 'Data::All::IO::Database');
    #Data::All::IO->register_factory_type(   ftp => 'Data::All::IO::FTP');
}


#   CONSTRUCTOR RELATED
sub init()
#   Rekindle all that we are
{
    my $self = shift;

    my $args = $self->reinit(@_);
    return $self;
}

sub reinit
{
    my $self = shift;
    my $args;

    return undef unless ($_[0]);

    #   Allow for hash or hashref args
    $args = (ref($_[0]) eq 'HASH') ? $_[0] : { @_ };

    populate($self, $args);

    $self->prep_collections();

    return $args;
}



sub prep_collections()
#   Prepare and store an instance of Data::All::IO::* for source and to configs
{
    my $self = shift;

    foreach (qw(source target))
    {
        $self->__collection()->{$_} = $self->_load_IO($self->$_())
            if (defined($self->$_()));
    }
}


sub _load_IO(\%)
#   Load an instance of Data::All::IO::? to memory
{
    my $self = shift;
    my $args = shift;

    $self->_parse_args($args);
    my ($ioconf, $format, $path, $fields) = @{ $args }{'ioconf','format','path','fields'};


    my $IO = Data::All::IO->new($ioconf->{'type'},
        {
            ioconf  => $ioconf,
            format  => $format,
            path    => $path,
            fields  => $fields
        });

    return $IO;
}

sub _parse_args()
#   Convert arrayref args into hashref, process determinable values,
#   and apply defaults to the rest. We can also through a horrible
#   error at this point if there isn't enoguh info for Data::All to
#   continue.
{
    my $self = shift;
    my $args = shift;

    #   TODO: Allow collection('filename.csv', 'profile'); usage
    $self->_apply_profile_to_args($args);

    #   Make sure path is an array ref
    $args->{'path'} = [$args->{'path'}]  if (ref($args->{'path'}) ne 'ARRAY');

    for my $a (keys %{ $self->__default() })
    #   Apply default values to data collection configuration. Amplify arrayref
    #   configs into hashref configs using the a2h_templates where appropriate.
    {
        next if $a eq 'path';

        if (ref($args->{$a}) eq 'ARRAY')
        {
            my (%hash, $templ);
            $templ = join '', $a, '.', $args->{$a}->[0];

			$self->error("Wasn't expecting: $templ"), next unless(exists($self->__a2h_template()->{$templ}));

            @hash{@{$self->__a2h_template()->{$templ}}} = @{ $args->{$a} };

            $args->{$a} = \%hash;
        }

        $self->_apply_default_to($a, $args);
    }

    return if ($args->{'moniker'});

    $args->{'moniker'} = ($args->{'ioconf'}->{'type'} ne 'db')
        ? join('', @{ $args->{'path'} })
        : '_';

}


sub _apply_profile_to_args(\%)
#   Populate format within args based on a preconfigured profile
{
    my $self = shift;
    my $args = shift;
	#print Dumper($args);
    my $p = $args->{'profile'} || $self->__default()->{'profile'};

    return if (exists($args->{'format'}));

    die("There is no profile for type $p ")
        unless ($p && exists($self->__profile()->{$p}));

    #   Set the format using the requested profile
    $args->{'format'} = $self->__profile()->{$p};
    return;
}

sub _apply_default_to()
#   Set a default value to a particular attribute.
#   TODO: Allow setting of individual attribute fields
{
    my $self = shift;
    my ($a, $args) = @_;
    $args->{$a} = $self->__default()->{$a}
        unless (exists($args->{$a}));

    return unless (ref($args->{$a}) eq 'HASH');

    foreach my $c (keys %{ $self->__default()->{$a} })
    {
        $args->{$a}->{$c} = $self->__default()->{$a}->{$c}
            unless (defined($args->{$a}->{$c}));
    }

}



sub count(;$)
#   get a record count
{
    my $self = shift;
    my $which = shift || 'source';

    $self->open() unless ($self->is_open($which));
    return $self->__collection()->{$which}->count();
}


sub count_to(;$)
#   get a record count for the source config
{
    my $self = shift;
    return $self->count('target');
}


sub count_source(;$)
#   get a record count for the source config
{
    my $self = shift;
    return $self->count('source');
}

sub getrecord(;$$)
#   Get a single, consecutive record
{
    my $self = shift;
    my $type = shift || 'hash';
    my $meth = 'getrecord_' . $type;
    my $record;

#    $record = ($self->__collection()->{'source'}->can($meth))
#        ? $self->__collection()->{'source'}->$meth()
#        : undef;

    return $self->__collection()->{'source'}->getrecord_hash();
}

sub putrecord()
#   Put a single, consecutive record
{
    my $self = shift;
    my $record = shift || return undef;

    $self->__collection()->{'target'}->putrecord()
}


sub collection(%)
#   Shorthand for creating a Data::All instance, openning, reading
#   and closing the data source
{
    my ($conf1, $conf2) = @_;
    my ($myself, $rec);

    #   We can accept standard-arg style, but we will also make provisions
    #   for a single hashref arg which we'll assume is the 'source' config
    $myself = (ref($_[0]) ne 'HASH')
        ? new('Data::All', @_)
        : new('Data::All', source => $_[0]);

    $myself->open();
    $rec = $myself->read();
    $myself->close();

    return (!wantarray) ? $rec : @{ $rec };
}

sub open(;$)
{
    my $self = shift;
    #my $which = shift || 'source';

    foreach my $source (keys %{ $self->__collection() })
    {
        $self->__collection()->{$source}->open();

        unless ($self->__collection()->{$source}->is_open())
        {
            $self->__ERROR($self->__collection()->{$source}->__ERROR());
            die "Cannot open ", $self->__collection()->{$source}->create_path();
        }
    }

    return;
}

sub close(;$)
{
    my $self = shift;
    #my $which = shift || 'source';

    foreach my $source (keys %{ $self->__collection() })
    {
        $self->__collection()->{$source}->close();
    }

    return;
}

sub show_fields(;$)
{
    my $self = shift;
    my $which = shift || 'source';
    $self->__collection()->{$which}->fields();
}

sub read(;$$)
{
    my $self = shift;
    my $which = shift || 'source';

    $self->open();
    my $records = $self->__collection()->{$which}->getrecords();

    return !wantarray ? $records :   @{ $records };
}

sub store
#   Store data source an array ref (of hashes) into a Data::All enabled source
#    IN: (arrayref) of hashes -- your records
#         [ standard parameters ]
#   OUT:
{
    my $self = shift;
    my $source = shift;
    my ($target, $bool);

    my $args = $self->reinit(@_);

    $target = $self->__collection()->{'target'};

    $target->open();

    $target->fields([keys %{ $source->[0] }])
        unless ($target->fields() && $#{ $target->fields() });

    $target->putfields()   if ($self->print_fields);

    #   Convert data in a wholesome fashion (rather than piecemeal)
    #   There is no point in doing it record by record b/c the
    #   records we are storing are already in memory.
    $bool = $target->putrecords($source, $args) ;

    $target->close();

    return 1;
}

sub convert
#   Move data source one Data::All collection to another, using a simple
#   source (source) and to (target) metaphor
#   TODO: need error detection
{
    my $self = shift;
    my ($source, $target, $bool);

    my $args = $self->reinit(@_);

    ($source, $target) = @{ $self->__collection() }{'source','target'};

    $source->open();
    $target->open();

    # TODO: Get fields source db SELECT before we copy to the $target->fields()

    #   Use the source's field names if the target's has none
    $target->fields($source->fields) unless ($target->fields() && $#{ $target->fields() });


    #   Print the field names into the target
    #   TODO: If the field list is in the source collection, then the
    #   fields will appear twice in the target file.
    $target->putfields()   if ($self->print_fields);

    if ($self->atomic) {
        #   Convert data in a wholesome fashion (rather than piecemeal)
        $bool = $target->putrecords([$source->getrecords()], $args) ;
    }
    else {
    #   Convert record by record (great for large family members!!!!!!!)
        while (my $rec = $source->getrecord_hash())
        { $bool = $target->putrecord($rec, $args) }
    }

    #   BUG: I commented this out for the extract specifically (delano - May 9)
    #$target->close();
    #$source->close();

    return $bool;
}


sub write(;$$)
{
    my $self = shift;
    my $which = shift || 'source';
    my ($start, $count) = (shift || 0, shift || 0);

}


sub is_open(;$)
{
    my $self = shift;
    my $which = shift || 'source';

    return $self->__collection()->{'source'}->is_open();
}










1;
__END__