File Coverage

blib/lib/Finance/Card/Citibank.pm

Criterion	Covered	Total	%
statement	21	147	14.2
branch	0	42	0.0
condition	0	7	0.0
subroutine	7	18	38.8
pod	1	1	100.0
total	29	215	13.4

package Finance::Card::Citibank;

# ABSTRACT: Check your credit card balances.

use strict;
use warnings;

use Carp;
use LWP;
use DateTime;
use HTML::Parser;

our $VERSION = '2.02';

my $ua = LWP::UserAgent->new();

sub check_balance {
    my ( $class, %opts ) = @_;
    my $self = bless {%opts}, $class;

    my $position = 1;
    my @accounts;

    my @ofx_accounts = $self->_get_accounts;
    for my $accnt (@ofx_accounts) {

        my $acctid = $accnt->{ccacctinfo}{ccacctfrom}{acctid};
        my $desc   = $accnt->{desc};
        # print "id: $acctid\n";
        # print "desc: $desc\n";

        my $balance =
          $self->_get_account_balance(
            $accnt->{ccacctinfo}{ccacctfrom}{acctid} );
        # print "balance: $balance\n";

        push @accounts, (
            bless {
                balance    => $balance,
                name       => $desc,
                sort_code  => $acctid,
                account_no => $acctid,
                position =>
                  $position++,    # redundant since just = array index + 1
                statement => undef,
                ## parent => $self,
            },
            "Finance::Card::Citibank::Account"
        );

    }

    return @accounts;
}

sub _get_accounts {
    my $self = shift;

    my $content = $self->_retrive_accounts;

    my ( $ofx_header, $ofx_body ) = split /\n\n/, $content, 2;
    my $tree = $self->_parse( $content );

    my $accntinfo =
      $tree->{ofx}{signupmsgsrsv1}{acctinfotrnrs}{acctinfors}{acctinfo};
    my @accounts = ref $accntinfo eq 'ARRAY' ? @$accntinfo : $accntinfo;

    return @accounts;
}

sub _get_account_balance {
    my ( $self, $account ) = @_;

    my $content = $self->_retrive_account_balance($account);
    my $tree = $self->_parse( $content );

    exists $tree->{ofx}{creditcardmsgsrsv1}{ccstmttrnrs}{ccstmtrs}{ledgerbal}
      {balamt}
      or confess "Unable to find balance: $content";
    my $balance =
      $tree->{ofx}{creditcardmsgsrsv1}{ccstmttrnrs}{ccstmtrs}{ledgerbal}
      {balamt};

    return $balance;
}

sub _retrive_accounts {
    my $self = shift;

    if ( $self->{content} ) {

        # If we give it a file, use the file rather than downloading
        open my $fh, "<", $self->{content} or confess;
        my $content = do { local $/ = undef; <$fh> };
        close $fh;
        return $content;
    }

    croak "Must provide a password" unless exists $self->{password};
    croak "Must provide a username" unless exists $self->{username};

    my $r =
      HTTP::Request->new( POST =>
          'https://secureofx2.bankhost.com/citi/cgi-forte/ofx_rt?servicename=ofx_rt&pagename=ofx'
      );
    $r->content_type('application/x-ofx');
    $r->content( <<"ACCNT_REQ" );
OFXHEADER:100
DATA:OFXSGML
VERSION:102
SECURITY:NONE
ENCODING:USASCII
CHARSET:1252
COMPRESSION:NONE
OLDFILEUID:NONE
NEWFILEUID:NONE




            @{[ DateTime->now->strftime('%Y%m%d%H%M%S.000') ]}
            @{[ $self->{username } ]}
            @{[ $self->{password} ]}
            ENG

                Citigroup
                24909

            QWIN
            1800




            @{[ DateTime->now->strftime('%Y%m%d%H%M%S.000') ]}
            1

                19691231




ACCNT_REQ

    # print "request: ", $r->as_string, "\n\n---\n\n";
    my $response = $ua->request($r);
    my $content  = $response->content;

    if ( $self->{log} ) {

        # Dump to the filename passed in log
        open( my $fh, ">", $self->{log} ) or confess;
        print $fh $content;
        close $fh;
    }

    return $content;

}

sub _retrive_account_balance {
    my ( $self, $account ) = @_;

    if ( $self->{content2} ) {

        # If we give it a file, use the file rather than downloading
        open my $fh, "<", $self->{content2} or confess;
        my $content = do { local $/ = undef; <$fh> };
        close $fh;
        return $content;
    }

    croak "Must provide a password" unless exists $self->{password};
    croak "Must provide a username" unless exists $self->{username};

    my $r =
      HTTP::Request->new( POST =>
          'https://secureofx2.bankhost.com/citi/cgi-forte/ofx_rt?servicename=ofx_rt&pagename=ofx'
      );
    $r->content_type('application/x-ofx');
    $r->content( <<"ACCNT_REQ" );
OFXHEADER:100
DATA:OFXSGML
VERSION:102
SECURITY:NONE
ENCODING:USASCII
CHARSET:1252
COMPRESSION:NONE
OLDFILEUID:NONE
NEWFILEUID:NONE




            @{[ DateTime->now->strftime('%Y%m%d%H%M%S.000') ]}
            @{[ $self->{username } ]}
            @{[ $self->{password} ]}
            ENG

                Citigroup
                24909

            QWIN
            1800




            @{[ DateTime->now->strftime('%Y%m%d%H%M%S.000') ]}
            1


                    @{[ $account ]}


                    19691231
                    N





ACCNT_REQ

    # print "request: ", $r->as_string, "\n\n---\n\n";
    my $response = $ua->request($r);
    my $content  = $response->content;

    if ( $self->{log2} ) {

        # Dump to the filename passed in log
        open( my $fh, ">", $self->{log2} ) or confess;
        print $fh $content;
        close $fh;
    }

    return $content;

}

sub _parse {
    my ($self,$content) = @_;

    my ( $ofx_header, $ofx_body ) = split /\n\n/, $content, 2;

    my @tree;
    my @stack;
    unshift @stack, \@tree;

    my $p = HTML::Parser->new(
        start_h => [
            sub {
                my $data = shift;

                my @content = ();
                push @{ $stack[0] }, { name => $data, content => \@content };
                unshift @stack, \@content;
            },
            'tagname'
        ],
        end_h => [
            sub {    # An end event unwinds the stack by one level
                shift(@stack);
            },
            ''
        ],
        text_h => [
            sub {
                my $data = shift;
                $data =~ s/^\s*//;    # Strip leading whitespace
                $data =~ s/\s*$//;    # Strip trailing whitespace
                return unless length $data;    # Ignore empty strings
                if ( scalar( @{ $stack[0] } ) ) {
                    print STDERR "Naked text\n";
                    return;
                }
                shift @stack;    # Unwind the vestigal array reference
                @{ $stack[0] }[-1]->{content} = $data;
            },
            'dtext'
        ] );
    $p->unbroken_text(1);   # Want element contents in single blocks to facilita
    $p->parse($ofx_body);

    my $tree = _collapse(\@tree);
    my $resp_code = $tree->{ofx}{signonmsgsrsv1}{sonrs}{status}{code};
    if ( undef $resp_code or $resp_code ) {    # Undef or not 0
        confess "Error in response from ofx server: $ofx_body";
    }

    return $tree;

}

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;
}

package Finance::Card::Citibank::Account;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(
    qw(balance name sort_code account_no position statement));

1;

__END__