view release on metacpan or  search on metacpan

lib/AnyData2/Format/Fixed.pm  view on Meta::CPAN

package AnyData2::Format::Fixed;

use 5.008001;
use strict;
use warnings FATAL => 'all';

use base qw(AnyData2::Format AnyData2::Role::GuessImplementation);

use Carp qw/croak/;
use List::Util '1.29', qw(pairkeys pairvalues);
use Module::Runtime qw(require_module);

=head1 NAME

AnyData2::Format::Fixed - fixed length format class for AnyData2

=cut

our $VERSION = '0.002';

=head1 METHODS

=head2 new

  # pure invocation
  my $af = AnyData2::Format::Fixed->new(
    $storage,
    cols => [ # important: hash changes order!
      "first" => 20,
      "second" => 15,
      ...
    ]
  );
  
  my $af = AnyData2->new(
    Fixed => {
        cols => [ Id => 3, Name => 10, Color => 7, Newline => 1 ]
    },
    # a File::Linewise example should do, either
    "File::Blockwise" => {
        filename  => File::Spec->catfile( $test_dir, "simple.blocks" ),
        blocksize => 3 + 10 + 7 + 1,
        filemode  => "<:raw"
    }
  );

constructs a storage, passes all options down to C<html_table_class>
beside C<html_table_class>, which is used to instantiate the parser.
C<html_table_class> prefers L<HTML::TableExtract> by default.

=cut

sub new
{
    my ( $class, $storage, %options ) = @_;
    my $self = $class->SUPER::new($storage);

    $self->{cols} = [ @{ delete $options{cols} } ];

    $self;
}

=head2 cols

Deliver the keys of the specification array

=cut

sub cols
{
    my $self = shift;
    [ pairkeys @{ $self->{cols} } ];
}

=head2 fetchrow

Extract the values from storages based on the values of the specification array

=cut

sub fetchrow
{
    my $self = shift;
    my $buf  = $self->{storage}->read();
    defined $buf or return;
    my @data;
    foreach my $len ( pairvalues @{ $self->{cols} } )
    {
        push @data, substr $buf, 0, $len, "";
    }
    \@data;
}

=head2 pushrow

Construct buffer based on the values of the specification array and write it into storage (unimplemented)

=cut

sub pushrow
{
    my ( $self, $fields ) = @_;
    croak "Write support unimplemented. Patches welcome!";
}

=head1 LICENSE AND COPYRIGHT

Copyright 2015,2016 Jens Rehsack.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

If your Modified Version has been derived from a Modified Version made