File Coverage

blib/lib/Parse/File/Metadata.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	22	24	91.6
condition	8	8	100.0
subroutine	9	9	100.0
pod	5	5	100.0
total	94	96	97.9

package Parse::File::Metadata;
use strict;
our $VERSION = '0.07';
use Carp;
use Scalar::Util qw( reftype );

=head1 NAME

Parse::File::Metadata - For plain-text files that contain both metadata and data records, parse metadata first

=head1 SYNOPSIS

     use Parse::File::Metadata;

    $metaref = {};
    @rules = (
        {
            rule => sub { exists $metaref->{d}; },
            label => q{'d' key must exist},
        },
        {
            rule => sub { $metaref->{d} =~ /^\d+$/; },
            label => q{'d' key must be non-negative integer},
        },
        {
            rule => sub { exists $metaref->{f}; },
            label => q{'f' key must exist},
        },
    );

    $self = Parse::File::Metadata->new( {
        file            => 'path/to/myfile',
        header_split    => '\s*=\s*',
        metaref         => $metaref,
        rules           => \@rules,
    } );

    $dataprocess = sub { my @fields = split /,/, $_[0], -1; print "@fields\n"; };

    $self->process_metadata_and_proceed( $dataprocess );

    $self->process_metadata_only();

    $metadata_out = $self->get_metadata();

    $exception = $self->get_exception();

=head1 DESCRIPTION

This module is useful when you have to parse a plain-text file that meets the
following conditions:

=over 4

=item *

The file consists of two types of records:

=over 4

=item *

A I section consisting of key-value pairs which constitute, in some
sense, I.

=item *

A I section consisting mainly or entirely of I records, which may be either delimited or fixed-width.

=item *

The header and the body are separated by one or more empty records.

=back

=item *

Your program must parse the metadata first, then make a decision on the basis
of the metadata whether to proceed with parsing of the data.  The metadata may
or may not be used in the parsing of the data.

=back

=head2 Example

Below is a plain-text file in which the header consists of key-value pairs
delimited by C<=> signs.  The key is the to the left of the first delimiter.
Everything to the right is part of the value (including any additional
delimiter characters).

The body consists of comma-delimited strings.  Whether in the body or the
header, comments begin with a C<#> sign and are ignored.

    # comment
    a=alpha
    b=beta,charlie,delta
    c=epsilon	zeta	eta
    d=1234567890
    e=This is a string
    f=,

    some,body,loves,me
    I,wonder,wonder,who
    could,it,be,you

Suppose you are told that you should proceed to parse the body if and only if
the following conditions are met in the header:

=over 4

=item * There must be a metadata element keyed on C.

=item * The value of metadata element C must be a non-negative integer.

=item * There must be a metadata element keyed on C.

=back

This file would meet all three criteria and the program would proceed to parse
the three data records.

If, however, metadata element C
were commented out:

    #f=,

the file would no longer meet the criteria and the program would cease before
parsing the data records.

=head1 METHODS

=head2 C

=over 4

=item * Purpose

Parse::File::Metadata constructor.   Validates input.

=item * Arguments

    $self = Parse::File::Metadata->new( {
        file            => 'path/to/myfile',
        header_split    => '\s*=\s*',
        metaref         => $metaref,
        rules           => \@rules,
    } );

Single hash reference.  Hash has the following elements:

=over 4

=item * C

Path, relative or absolute, to the file needing parsing.

=item * C

Hard-quoted string holding a Perl 5 regex to be used for parsing metadata
records.

=item * C

Empty hash-reference.

=item * C

Reference to an array of hashrefs.  Each such hashref has two elements:

=over 4

=item * C

Reference to a subroutine describing a criterion which the header must pass
before parsing of the body begins.  The subroutine returns a true value when
the criterion is met and an undefined value when the criterion is not met.

=item * C

A human-friendly string which will be used to populate exceptions if the
criteria are not met.

=back

The rules are applied in the order specified in the array.

=back

=item * Return Value

Parse::File::Metadata object.

=back

=cut

sub new {
    my ($class, $args) = @_;
    croak "Metadata hash must start out empty: $!"
        unless ( reftype($args->{metaref}) eq 'HASH' and
            ! keys %{ $args->{metaref} } );
    croak "Rules must be in array ref: $!"
        unless ( reftype($args->{rules}) eq 'ARRAY' );

    my $self = bless $args, $class;

    return $self;
}

=head2 C

=over 4

=item * Purpose

Process metadata rows found in file header and test the resulting hash against
the criteria specified in the rules.  If all criteria are met, proceed to
parse the data rows with the subroutine specified as argument to this method.

=item * Arguments

    $dataprocess = sub { my @fields = split /,/, $_[0], -1; print "@fields\n"; };

    $self->process_metadata_and_proceed( $dataprocess );

=item * Return Values

None.  Use C and C methods to obtain that
data.

=back

=cut

sub process_metadata_and_proceed {
    my ($self, $dataprocess) = @_;
    croak "Must define subroutine for processing data rows: $!"
        unless ( defined($dataprocess) and reftype($dataprocess) eq 'CODE' );

    $self->_process_metadata_engine($dataprocess);
}

sub _process_metadata_engine {
    my $self = shift;
    my $dataprocess = shift || undef;
    my $header_seen;
    my $exception = [];
    open my $FILE, '<', $self->{file}
        or croak "Unable to open file for reading";
    THISFILE: while (my $l = <$FILE>) {
        next if $l =~ /^#/;
        $l =~ s/[\r\n]+$//g;
        if (! $header_seen) {
            if ($l eq '') {
                $header_seen++;
            }
            else {
                next unless $l =~ /^(.+?)$self->{header_split}(.*)$/;
                my ($k, $v) = ($1, $2);
                $self->{metaref}->{$k} = $v;
            }
        }
        else {
            foreach my $r ( @{ $self->{rules} } ) {
                unless ( &{ $r->{rule} } ) {
                    push @{$exception}, $r->{label};
                }
            }
            last THISFILE if scalar @{$exception};
            &{ $dataprocess }($l)
                if defined $dataprocess;
        }
    }
    close $FILE or croak "Unable to close";
    $self->{exception} = $exception;
};

=head2 C

=over 4

=item * Purpose

Same as L, except that it returns before
beginning any processing of the data records.

=item * Arguments

    $self->process_metadata_only();

=item * Return Values

None.

=back

=cut

sub process_metadata_only {
    my $self = shift;
    $self->_process_metadata_engine();
}

=head2 C

=over 4

=item * Purpose

Access metadata in file's header section.

=item * Arguments

    $metadata_out = $self->get_metadata()

None.

=item * Return Values

Hash of metadata found in file's header.

=back

=cut

sub get_metadata {
    my $self = shift;
    return $self->{metaref};
}

=head2 C

=over 4

=item * Purpose

Access reasons, if any, why file failed to meet specified criteria.

=item * Arguments

    $exception = $self->get_exception()

None.

=item * Return Values

Reference to an array holding lists of Cs for rules on which the
metadata fails.

=back

=cut

sub get_exception {
    my $self = shift;
    return $self->{exception};
}

=head1 SUPPORT

L

=head1 AUTHOR

    James E Keenan
    CPAN ID: jkeenan
    Perl Seminar NY
    [e-mail]
    http://thenceforward.net/perl/modules/Parse-File-Metadata

=head1 COPYRIGHT

Copyright 2010 James E Keenan

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=head1 SEE ALSO

perl(1).

=cut