/usr/local/CPAN/Data-All/Data/All/IO/File.pm

• package Data::All::IO::File
  • create_path
  • open
  • close
  • nextrecord
  • hash_to_record
  • array_to_record
  • getrecord_array
  • putfields
  • putrecord
  • _extract_fields
  • count
  • _next
• EOF

package Data::All::IO::File;


use strict;
use warnings;

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


our $VERSION = 0.11;

internal 'IO';
internal 'fh';

attribute 'format';
attribute 'fields';
attribute 'ioconf';
attribute   'path';

attribute 'is_open'             => 0;

internal 'FORMAT';
internal 'curpos'               => -1;
internal 'added_fields'         => {};


sub create_path()
{
    my $self = shift;
    return join '', @{ $self->path };
}

sub open($)
{
    my $self = shift;
    my $path = $self->create_path();
    
    unless ($self->is_open())
    {
        #warn " -> Opening $path for ", $self->ioconf()->{'perm'};
        #warn " -> path:", join ', ', @{ $self->path() };
        #warn " -> format:", $self->format()->{'type'};
        #warn " -> io:", $self->ioconf->{'type'};
    
        die("The file: $path does not exist")
            if (($self->ioconf()->{'perm'} eq 'r') && !(-f $path));
    
        #   We create out own filehandle for better read/write control
        my $fh = FileHandle->new($self->create_path(), $self->ioconf()->{'perm'});        
        
        $self->__IO( $fh );
        $self->__fh( $fh );
        
        $self->is_open(1);
    
        $self->_extract_fields();             #   Initialize field names
    }
    
    return $self->is_open();
}

sub close()
{
    my $self = shift;
    
	$self->__fh()->close();
	
    $self->__IO()->close();
    $self->is_open(0);
}

sub nextrecord() 
{  
    my $self = shift;
    my $r;
    
    #   TODO: Write an actual solution for converting from
    #   one line terminator to another.

    #   Incrememnt cursor and remove trailing line
    if ($r = $self->__fh()->getline())
    {  
        $r =~ s/\r\n/\n/g;      #   NOTE: a quick hack to convert DOS to UNIX
        chomp($r);  
        $self->_next();
    }
    
    return $r;
}

sub hash_to_record()
{
    my ($self, $hash) = @_;
	
    #   we do it like this to make sure the order is the same
    return $self->array_to_record($self->hash_to_array($hash));
}

sub array_to_record()
{
    my ($self, $array) = @_;
    return $self->__FORMAT()->contract($array);
}



sub getrecord_array() 
#   With original = include original record from file
{ 
    my ($self, $with_original) = @_;
    my $raw;
    
    return undef unless ($raw = $self->nextrecord());
    
    #   We return the original record first b/c if we do it
    #   last and there are empty values at the end the order will be confused
    my $rec_arrayref = ($with_original)
        ? [$raw, $self->__FORMAT()->expand($raw)]
        : [$self->__FORMAT()->expand($raw)];
    
    return !wantarray ? $rec_arrayref : @{ $rec_arrayref };
}
 
sub putfields()
{
    my $self = shift;
    $self->__IO()->print($self->array_to_record($self->fields));
}

sub putrecord($)
{
    my $self = shift;
    my $record = shift;
	
    $self->__IO()->print($self->hash_to_record($record));
    
    return 1;
}


sub _extract_fields()
{
    my $self = shift;
    return if ($self->fields());
    $self->fields([$self->getrecord_array(0)]);
}

sub count()     
{ 
    my $self = shift;
    my $count;
    
    #   From the Perl Cookbook. It doesn't actually replace every
    #   new line with a new new line -- it's a legacy feature. 
    $count += tr/\n/\n/ while sysread($self->__fh(), $_, 2 ** 20);
    
    return $count;
}
sub _next()      { $_[0]->__curpos( $_[0]->__curpos() + 1) }


1;