File Coverage

blib/lib/Data/FixedFormat.pm

Criterion	Covered	Total	%
statement	87	115	75.6
branch	11	24	45.8
condition	4	4	100.0
subroutine	15	24	62.5
pod	5	6	83.3
total	122	173	70.5

package Data::FixedFormat;

use strict;
our $VERSION = "0.04";
1;

package Data::FixedFormat;

sub new {
    my ($class, $layout) = @_;
    my $self;
    if (ref $layout eq "HASH") {
	$self = new Data::FixedFormat::Variants $layout;
    } else {
	$self = { Names=>[], Count=>[], Format=>"", Fields=>{} };
	bless $self, $class;
	$self->parse_fields($layout) if $layout;
    }
    return $self;
}

sub parse_fields {
    my ($self,$fmt) = @_;
    my $ofs = 0;
    foreach my $fld (@$fmt) {
	my ($name, $format, $count) = split ':',$fld;
	push @{$self->{Names}}, $name;
	push @{$self->{Count}}, $count;
	$self->{Format} .= $format x ($count || 1);
        $self->{Fields}{$name} = $ofs;
        $ofs += ($count || 1);
    }
}

sub unformat {
    my ($self,$frec) = @_;
    my @flds = unpack $self->{Format}, $frec;
    my $i = 0;
    my $rec = {};
    @{$rec}{@{$self->{Names}}} =
        map { defined($_) ? [ splice @flds, 0, $_ ] : shift @flds }
            @{$self->{Count}};
    return $rec;
}

sub unformat_tied {
    my ($self,$frec) = @_;
    my @flds = unpack $self->{Format}, $frec;
    tie my %h, 'Data::FixedFormat::Tied', $self, \@flds;
    return \%h;
}

sub format {
    my ($self,$rec) = @_;
    my @flds;
    my $i = 0;
    foreach my $name (@{$self->{Names}}) {
	if ($self->{Count}[$i]) {
	    push @flds,@{$rec->{$name}};
	} else {
	    push @flds,$rec->{$name};
	}
    	$i++;
    }
    my $frec = pack $self->{Format}, @flds;
    return $frec;
}

sub blank {
    my $self = shift;
    my $rec = $self->unformat(pack($self->{Format},
				   unpack($self->{Format},
					  '')));
    return $rec;
}

package Data::FixedFormat::Tied;
use strict;

sub TIEHASH {
    my ($class,$dff,$data) = @_;
    bless { Dff=>$dff, Data=>$data },$class;
}

sub FETCH {
    my ($self,$key) = @_;
    exists($self->{Dff}{Fields}{$key}) or die "Undefined key: $key";
    my $idx = $self->{Dff}{Fields}{$key};
    if ($self->{Dff}{Count}[$idx]) {
        die "Array fields not yet supported with tied interface";
    } else {
        $self->{Data}[$idx];
    }
}

sub STORE {
    my ($self,$key,$value) = @_;
    exists($self->{Dff}{Fields}{$key}) or die "Undefined key: $key";
    my $idx = $self->{Dff}{Fields}{$key};
    if ($self->{Dff}{Count}[$idx]) {
        die "Array fields not yet supported with tied interface";
    } else {
        $self->{Data}[$idx] = $value;
    }
}

sub DELETE {
    my ($self,$key) = @_;
    die "Not Yet Implemented";
}

sub CLEAR {
    my ($self) = @_;
    die "Not Yet Implemented";
}

sub EXISTS {
    my ($self,$key) = @_;
    exists($self->{Dff}{Fields}{$key});
}

sub FIRSTKEY {
    my ($self) = @_;
    $self->{Dff}{Names}[0];
}

sub NEXTKEY {
    my ($self,$lastkey) = @_;
    $self->{Dff}{Names}[$self->{Dff}{Fields}{$lastkey}+1];
}

sub UNTIE {
#    my ($self) = @_;
}

sub DESTROY {
#    my ($self) = @_;
}

package Data::FixedFormat::Variants;
use strict;

sub new {
    my ($class,$recfmt) = @_;
    my $self;
    $self = { Layouts=>[], Chooser=>$recfmt->{Chooser} };
    bless $self, $class;
    foreach my $fmt (@{$recfmt->{Formats}}) {
	push @{$self->{Layouts}},new Data::FixedFormat $fmt;
    }
    return $self;
}

sub unformat {
    my ($self,$frec) = @_;
    my $rec = $self->{Layouts}[0]->unformat($frec);
    my $w = &{$self->{Chooser}}($rec);
    $rec = $self->{Layouts}[$w]->unformat($frec) if $w;
    return $rec;
}

sub unformat_tied {
    my ($self,$frec) = @_;
    my $rec = $self->{Layouts}[0]->unformat_tied($frec);
    my $w = &{$self->{Chooser}}($rec);
    $rec = $self->{Layouts}[$w]->unformat_tied($frec) if $w;
    return $rec;
}

sub format {
    my ($self,$rec) = @_;
    my $w = 0;
    if ($self->{Chooser}) {
	$w = &{$self->{Chooser}}($rec);
    }
    my $frec = $self->{Layouts}[$w]->format($rec);
    return $frec;
}

sub blank {
    my ($self,$w) = @_;
    $w = 0 unless $w;
    my $rec = $self->{Layouts}[$w]->blank();
    return $rec;
}

__END__