File Coverage

blib/lib/Finance/OFX/Parse.pm

Criterion	Covered	Total	%
statement	12	66	18.1
branch	0	22	0.0
condition	0	10	0.0
subroutine	4	9	44.4
pod	2	5	40.0
total	18	112	16.0

# Filename: Parse.pm
# Parse the Open Financial Exchange format
# http://www.ofx.net/
#
# Created January 30, 2008	Brandon Fosdick
#
# Copyright 2008 Brandon Fosdick  (BSD License)
#
# $Id: Parse.pm,v 1.2 2008/03/04 04:22:27 bfoz Exp $

package Finance::OFX::Parse;

use strict;
use warnings;

our $VERSION = '2';

use Finance::OFX::Tree;
use HTTP::Date;

sub is_unique
{
    my $a = shift;
    return undef unless ref($a) eq 'ARRAY';
    my %saw;
    $saw{$_->{name}}++ || return 0 for @{$a};
    1;
}

sub collapse
{
    my $tree = shift;
    return $tree unless ref($tree) eq 'ARRAY';

    # Recurse on any elements that have arrays for content
    $_->{content} = collapse($_->{content}) for( @{$tree} );

    # The passed array can be converted to a hash if all of it's nodes have
    #  unique names
    my %a;
    if( is_unique($tree) )
    {
	$a{$_->{name}} = $_->{content} for ( @{$tree} );
    }
    else	# Duplicate names can be converted to an array
    {
	my %b;
	$b{$_->{name}}++ for @{$tree};
#	grep(!$b{$_->{name}}++, @{$tree});
	($b{$_} > 1) && ($a{$_} = []) for keys %b;
	for( @{$tree} )
	{
	    push(@{$a{$_->{name}}}, $_->{content}), next if $b{$_->{name}} > 1;
	    $a{$_->{name}} = $_->{content};
#	    ($b{$_->{name}} > 1) ? push(@{$a{$_->{name}}}, $_->{content}) :
#				   ($a{$_->{name}} = $_->{content});
	}
    }
    return \%a;
}

sub parse_dates
{
    my $tree = shift;

    if( ref($tree) eq 'ARRAY' )
    {
	parse_dates($_) for @{$tree};
    }
    elsif( ref($tree) eq 'HASH' )
    {
	for( keys %{$tree} )
	{
	    if( /^dt/ )
	    {
		# Add seconds spacer
		$tree->{$_} =~ s/^([0-9]{12})([0-9]{2})/$1:$2/;
		# Add minutes spacer
		$tree->{$_} =~ s/^([0-9]{10})([0-9]{2})/$1:$2/;
		# Add date spacers
		$tree->{$_} =~ s/^([0-9]{4})([0-9]{2})([0-9]{2})/$1-$2\-$3 /;
		# Add a leading zero to the timezone offset, if needed
		$tree->{$_} =~ s/\[([-+]?)([0-9]):[A-Z]{3}\]/ $1\x30$2\x30\x30/;
		# Handle timezone offsets that were already 2 digits
		$tree->{$_} =~ s/\[([-+]?)([0-9]{1,2}):[A-Z]{3}\]/ $1$2\x30\x30/;
		# Do the conversion
		$tree->{$_} = str2time($tree->{$_}, 'GMT');
	    }
	    else
	    {
		parse_dates($tree->{$_});
	    }
	}
    }
}

sub parse
{
    $_[0] =~ s/\x0D//g;			# Un-networkify newlines

    my ($header, $body) = split /\n\n/, shift, 2;

    # Parse the OFX header block
    $header =~ s/^\s//;				# Strip leading whitespace
    my %header = split /[:\n]/, $header;	# Convert to a hash

    return undef unless ($header{OFXHEADER} == '100') and ($header{DATA} eq 'OFXSGML');

    my $tree = Finance::OFX::Tree::parse($body);
    return undef unless $tree and ($tree->[0]{name} eq 'ofx');

    $tree = collapse($tree);		# Collapse the parse tree into a hash
    parse_dates($tree);			# Convert date elements to Unix time

    # Merge the header hash into the parse tree
    $tree->{header} = \%header;

    return $tree;
}

sub parse_file
{
    my $file = shift;
    return undef unless $file;
#    my $text = do { local(@ARGV, $/) = $file; <> };
    my $text = read_file($file);
    return undef unless $text;
    return parse($text);
}

1;

__END__