File Coverage

blib/lib/LotusNotes/LoadExport.pm

Criterion	Covered	Total	%
statement	12	98	12.2
branch	0	32	0.0
condition	0	5	0.0
subroutine	4	8	50.0
pod	3	3	100.0
total	19	146	13.0

#
#  LoadExport.pm
#
#  Load records from a Lotus Notes database export.
#  Expects an array reference of fields to extract.
#  Returns an array reference of hashes where each hash represents a record
#
package LotusNotes::LoadExport;

our $VERSION = sprintf("%d.%02d", q'$Revision: 1.1 $' =~ /(\d+)\.(\d+)/);

use strict;
use warnings;
use Carp;
use IO::File;

my @data;

sub new
{
    my $proto  = shift;
    my $class  = ref($proto) || $proto;

    my $self = {};
    bless($self, $class);

    # Run initialisation code
    $self->_init(@_);

    return $self;
}


sub _init
{
    my $self = shift;

    # Handle the passed arguments
    my %args = (
        filename   => 'required',
        fieldnames => 'required array ref',
        @_
    );

    # Make sure we have the required arguments
    unless ($args{filename})
    {
        carp('E921 - No filename provided to LotusNotes::LoadExport->new(filename => the_export_filename, fieldnames => \@fields', "\n");
    }
    unless (-r $args{filename})
    {
        carp('E922 - filename ', $args{filename}, " does not exist or is not readable\n");
    }

    unless ($args{fieldnames})
    {
        carp('E923 - fieldnames array reference not provided to LotusNotes::LoadExport->new(filename => the_export_filename, fieldnames => \@fields', "\n");
    }
    unless (@{$args{fieldnames}})
    {
        carp("E925 - fieldnames array reference does not have any fieldnames!\n");
    }


    # Store the arguments we want
    $self->{filename}   = $args{filename};
    $self->{fieldnames} = $args{fieldnames};
}


sub load
{
    my $self = shift;

    my $fh = IO::File->new($self->{filename}, 'r');
    unless ($fh)
    {
        carp("E926 - Open of ", $self->{filename}, " failed:$!\n");
    }


    # Generate the regex to match the labels and extract the data
    my $regex_str;
    foreach my $label (@{ $self->{fieldnames} })
    {
        $regex_str .= q{^(} . $label . q{):\s+(.*)\s*$|};
    }
    # Remove the trailing pipe character
    $regex_str =~ s/\|$//;
    my $regex = qr{$regex_str};

    my %record;
    my $record_cnt = 0;

    while (<$fh>)
    {
        # This the the end of record flag
        if (/\f/)
        {
            push @data, { %record };
            $record_cnt++;
            %record = ();
            next;
        }

        chomp;
        if ((my @matched) = $_ =~ $regex)
        {
            my ($label, $value) = grep { $_ && $_ ne '' } @matched;
            $record{$label} = $value;
        }
    }

    # Handle the last record if not already added to the array
    if (keys %record)
    {
        push @data, { %record };
    }


    $fh->close();

    $self->{record_cnt} = $record_cnt;

    return \@data;
}


sub get_next
{
    my $self = shift;

    my $fh;
    my $file_position;
    if ($self->{get_next_fh})
    {
        $fh            = $self->{get_next_fh};
        $file_position = $self->{get_next_file_position} || 0;
        $fh->setpos($file_position);

        $self->{get_next_record_cnt} = 0;
    }
    else
    {
        $fh = IO::File->new($self->{filename}, 'r');
        unless ($fh)
        {
            carp("E926 - Open of ", $self->{filename}, " failed:$!\n");
        }
        $file_position = 0;

        # Sore for later use
        $self->{get_next_fh}            = $fh;
        $self->{get_next_file_position} = $file_position;
    }


    # Generate the regex to match the labels and extract the data
    my $regex;
    if ($self->{get_next_regex})
    {
        $regex = $self->{get_next_regex};
    }
    else
    {
        my $regex_str;
        foreach my $label (@{ $self->{fieldnames} })
        {
            $regex_str .= q{^(} . $label . q{):\s+(.*)\s*$|};
        }
        # Remove the trailing pipe character
        $regex_str =~ s/\|$//;
        $regex = qr{$regex_str};

        # Sore for later use
        $self->{get_next_regex} = $regex;
    }

    my %record;
    while (<$fh>)
    {
        # This the the end of record flag
        if (/\f/)
        {
            $self->{get_next_record_cnt}++;
            $self->{get_next_file_position} = $fh->getpos();
            return \%record;
        }

        chomp;
        if ((my @matched) = $_ =~ $regex)
        {
            my ($label, $value) = grep { $_ && $_ ne '' } @matched;
            $record{$label} = $value;
        }
    }

    # Handle the last record if not already added to the array
    if (keys %record)
    {
        $self->{get_next_record_cnt}++;
        return \%record;
    }

    $fh->close();
    return;
}


#####################################################################
# DO NOT REMOVE THE FOLLOWING LINE, IT IS NEEDED TO LOAD THIS LIBRARY
1;


__END__