view release on metacpan or  search on metacpan

lib/File/Kvpar.pm  view on Meta::CPAN

    my ($fh, $elems, $pos) = @$self{qw(fh elements pos)};
    seek $fh, 0, 2 or die "Can't seek to end: $!";
    my @elems = @$elems;
    push @elems, @_;
    my @pars = map { _hash2par($_) } @_;
    print $fh @pars;
    $self->{'pos'} = @$elems;
    @$elems = @elems;
    return $self;
}

sub truncate {
    my ($self) = @_;
    my ($fh, $elems, $pos) = @$self{qw(fh elements pos)};
    my $ofs = tell $fh;
    truncate $fh, $ofs;
    splice @$elems, $pos;
    return $self;
}

sub _hash2par {
    my ($hash) = @_;
    my $par = '';
    my %hash = %$hash;
    my ($at, $lb) = delete @hash{'@','#'};
    if (defined $at) {
        $par .= '@' . $at;
        $par .= ' ' . $lb if defined $lb;
        $par .= "\n";
    }
    foreach my $k (sort keys %hash) {
        my $v = $hash{$k};
        $par .= "$k $v\n" if defined $v;
    }
    $par = "#empty\n" if !length $par;
    return $par . "\n";
}

sub _par2hash {
    my ($par) = @_;
    chomp $par;
    my %hash;
    foreach (split /\n/, $par) {
        if (/^[@](\S*)(?: (.+))?$/) {
            $hash{'@'} = $1 if length $1;
            $hash{'#'} = $2 if defined $2;
        }
        elsif (/^[#]/) {
            next;
        }
        elsif (/^(\S+) (.*)$/) {
            $hash{$1} = $2;
        }
    }
    return \%hash;
}

sub _read_one {
    my ($self) = @_;
    my $fh = $self->{'fh'};
    local $/ = '';
    my $elems = $self->{'elements'};
    if (my $par = <$fh>) {
        $self->{'pos'}++;
        my $hash = _par2hash($par);
        push @{ $elems }, $hash;
        $self->{'have_read'} |= HEAD;
        return $hash;
    }
    else {
        $self->{'have_read'} |= TAIL;
        return;
    }
}

sub _read_remainder {
    my ($self) = @_;
    my ($hash, @rem);
    while ($hash = $self->_read_one) {
        push @rem, $hash;
    }
    return @rem;
}

sub head {
    my ($self) = @_;
    my $elems = $self->{'elements'};
    return $self->_read_one if !@$elems;
    return $elems->[0];
}

sub tail {
    my ($self) = @_;
    my $elems = $self->{'elements'};
    $self->_read_remainder if !( $self->{'have_read'} & TAIL );
    return if @$elems < 2;
    return @$elems[1..$#$elems];
}

sub reset {
    my ($self) = @_;
    seek $self->{'fh'}, 0, 0 or die "Can't seek to beginning of file: $!";
    $self->{'pos'} = 0;
    $self->{'elements'} = [];
    $self->{'have_read'} = 0;
    return $self;
}

sub elements {
    my ($self) = @_;
    my $elems = $self->{'elements'};
    $self->_read_remainder if ( $self->{'have_read'} & (HEAD|TAIL) ) != (HEAD|TAIL);
    return @$elems;
}

1;

=pod

=head1 NAME