=head1 NAME

Finance::Bank::IE::PTSB - Finance::Bank interface for Permanent TSB (Ireland)

=head1 DESCRIPTION

This module implements the Finance::Bank 'API' for Permanent TSB
(Ireland)'s Open24 online banking service.

=over

=cut
package Finance::Bank::IE::PTSB;

use base qw( Finance::Bank::IE );

our $VERSION = "0.28";

use warnings;
use strict;

use Carp;
use File::Path;

use constant BASEURL => 'https://www.open24.ie/online/';

my %pages = (
             login => {
                       url => 'https://www.open24.ie/online/login.aspx',
                       sentinel => 'LOGIN STEP 1 OF 2',
                      },
             login2 => {
                        url => 'https://www.open24.ie/online/Login2.aspx',
                        sentinel => 'LOGIN STEP 2 OF 2',
                       },
             accounts => {
                          url => 'https://www.open24.ie/online/Account.aspx',
                          sentinel => 'CLICK ACCOUNT NAME FOR A MINI STATEMENT',
                         },
             accountdetails => {
                                url => 'https://www.open24.ie/online/StateMini.aspx?ref=0',
                                sentinel => 'MINI STATEMENT',
                               },
             payandtransfer => {
                                url => "https://www.open24.ie/online/PayAndTransfer.aspx",
                                sentinel => "Payments & Transfers",
                               },
    );

sub _pages {
    return \%pages;
}

sub _submit_first_login_page {
    my $self = shift;
    my $confref = shift||$self->cached_config();

    $self->_add_event_fields();

    return
      $self->_agent()->submit_form( fields => {
                                               txtLogin => $confref->{user},
                                               txtPassword => $confref->{password},
                                               '__EVENTTARGET' => 'lbtnContinue',
                                               '__EVENTARGUMENT' => '',
                                              }
                                  );
}

sub _submit_second_login_page {
    my $self = shift;
    my $confref = shift;

    my @pins = grep /(Digit No. \d+)/, split( /[\r\n]+/, $self->_agent()->content );
    my %submit;
    my @secrets = split( //, $confref->{pin} );
    for my $pin ( @pins ) {
        my ( $digit, $field ) = $pin =~
          m{Digit No. (\d+).*input name="(.*?)"};
        my $secret = $secrets[$digit - 1];
        $submit{$field} = $secret;
    }
    $submit{'__EVENTTARGET'} = 'btnContinue';
    $submit{'__EVENTARGUMENT'} = '';
    $self->_add_event_fields();
    return $self->_agent()->submit_form( fields => \%submit );
}

=item * check_balance( [config] )

 Check the balances on all accounts. Optional config hashref.

=cut

sub check_balance {
    my $self = shift;
    my $confref = shift;

    $confref ||= $self->cached_config();
    my $res = $self->_get( $pages{accounts}->{url}, $confref );

    return unless $res;

    # find table class="statement"
    # first is headers (account name, number-ending-with, balance, available
    # each subsequent one is an account
    my @headers;
    my @accounts;
    my $parser = new HTML::TokeParser( \$res );
    while( my $tag = $parser->get_tag( "table" )) {
        next unless $self->_streq( $tag->[1]{class}, "statement" );

        my @account;
        while( $tag = $parser->get_tag( "th", "td", "/tr", "/table" )) {
            last if $tag->[0] eq "/table";
            if ( $tag->[0] =~ /^t[hd]$/ ) {
                my $closer = "/" . $tag->[0];
                my $text = $parser->get_trimmed_text( $closer );
                if ( $tag->[0] eq "th" ) {
                    push @headers, $text;
                } else {
                    push @account, $text;
                }
            } else { # ( $tag->[0] eq "/tr" ) {
                if ( @account ) {
                    push @accounts, [ @account ];
                    @account = ();
                }
            }
        }
    }

    # match headers to data
    my @return;
    for my $account ( @accounts ) {
        my %account;

        for my $header ( @headers ) {
            my $data = shift @{$account};

            if ( $header =~ /Account Name/ ) {
                $account{type} = $data;
                $account{nick} = $data;
            } elsif ( $header =~ /Account No\./ ) {
                $account{account_no} = $data;
            } elsif ( $header =~ /Account Balance \((\w+)\)/ ) {
                $account{currency} = $1;
                $account{balance} = $data;
            }
        }
        # prune stuff we can't identify
        next if !defined( $account{balance} );
        push @return, bless \%account, "Finance::Bank::IE::PTSB::Account";
    }

    return @return;
}

=item * account_details( $account [, config] )

 Return transaction details from the specified account

=cut

sub account_details {
    my $self = shift;
    my $wanted = shift;
    my $confref = shift;

    my @details;

    $confref ||= $self->cached_config();

    my $res = $self->_get( $pages{accounts}->{url}, $confref );

    return unless $res;
    return unless $wanted;

    # this is pretty brutal
    my @likely = grep {m{(StateMini.aspx\?ref=\d+).*?$wanted}} split( /[\r\n]/, $res );
    if ( scalar( @likely ) == 1 ) {
        my ( $url ) = $likely[0] =~ m/^.*(StateMini[^"]+)".*$/;
        # convert to an absolute URL so that the _get pagelookup works
        my $uri = new_abs URI( $url, $self->_agent()->response()->request->uri());
        $res = $self->_get( $uri->as_string(), $confref );

        # parse!
        # there's a header table which is untagged
        # and then there's this (tblTransactions):
        # <tr>
        #       <td class="Content" align="left" valign="middle" colspan="1" width="18%">DD/MM/YYYY</td><td class="Content" align="left" valign="middle" colspan="1" width="46%">DESC</td><td class="Content" align="right" valign="middle" colspan="1" width="18%">- AMT (withdrawal) or + AMT (deposit)</td><td class="Content" align="right" valign="middle" colspan="1" width="18%">BALANCE +/-</td>
        #   </tr>

        my $parser = new HTML::TokeParser( \$res );
        while( my $tag = $parser->get_tag( "table" )) {
            if ( $self->_streq( $tag->[1]{id}, "tblTransactions" )) {
                $self->_dprintf( "Found transaction table\n" );
                my @fields;
                while( my $tag = $parser->get_tag( "td", "/tr", "/table" )) {
                    if ( $tag->[0] eq "td" ) {
                        push @fields, $parser->get_trimmed_text( "/td" );
                    } elsif ( $tag->[0] eq "/tr" ) {
                        if ( @fields ) { # there are spurious blank lines
                            my ( $dr, $cr ) = ( 0, 0 );
                            if ( $fields[2] =~ /^-/ ) {
                                ( $dr = $fields[2] ) =~ s/^- //;
                            } else {
                                ( $cr = $fields[2] ) =~ s/^\+ //;
                            }

                            my ( $bal, $sign ) = $fields[3] =~ /^(.*) (.)$/;

                            push @details,
                            [
                             $fields[0],
                             $fields[1],
                             $dr,
                             $cr,
                             $sign.$bal,
                             ]
                             ;
                            @fields = ();
                        }
                    } else {
                        last;
                    }
                }
                last;
            }
        }

    } else {
        $self->_dprintf( "Found " . scalar(@likely) . " matches\n" );
        return;
    }

    unshift @details, [ 'Date', 'Desc', 'DR', 'CR', 'Balance' ];

    return @details;
}

=item * $self->_get_payments_page( account [, config ] )

 Get the third-party payments page for account

=cut

sub _get_payments_page {
    my $self = shift;
    my $account_from = shift;
    my $confref = shift;

    return unless $account_from;

    # allow passing in of account objects
    if ( ref $account_from eq "Finance::Bank::IE::PTSB::Account" ) {
        $account_from = $account_from->{nick};
    }

    $confref ||= $self->cached_config();
    my $res = $self->_get( $pages{accounts}->{url}, $confref );

    return unless $res;

    $self->_get( $pages{payandtransfer}->{url} )
      or return 0;
    $self->_save_page();

    if ( $self->_agent()->content() !~ /Payments &amp; Transfers/is ) {
        $self->_dprintf( "PayAndTransfer.aspx doesn't contain sentinel\n" );
        return 0;
    }

    return 1;
}

=item * $self->list_beneficiaries( account )

 List beneficiaries of C<account>

=cut
sub list_beneficiaries {
    my $self = shift;
    my $account_from = shift;
    my $confref = shift;

    return unless $self->_get_payments_page( $account_from, $confref );

    # follow link to 'manage accounts'
    $self->_add_event_fields();
    my $res = $self->_agent()->submit_form(
                                        fields => {
                                                   '__EVENTTARGET' => 'ctl00$cphBody$lbManageMyPayeeAccounts',
                                                   '__EVENTARGUMENT' => '',
                                                  }
                                       );

    $self->_save_page();
    return unless $res->is_success();

    my @beneficiaries;

    for my $ddlPaymentType ( 0..3 ) {
        if ( $ddlPaymentType > 0 ) {
            $self->_add_event_fields();
            $res = $self->_agent()->submit_form(
                                                fields => {
                                                           '__EVENTTARGET' => 'ctl00$cphBody$ddlPaymentType',
                                                           '__EVENTARGUMENT' => '',
                                                           'ctl00$cphBody$ddlPaymentType' => $ddlPaymentType,
                                                          }
                                               );
            $self->_save_page( "ddlPaymentType=$ddlPaymentType" );
            return unless $res->is_success();
        }

        my $page = $self->_agent()->content;
        my $parser = new HTML::TokeParser( \$page );

        my @beneficiary;
        my $found = 0;
        while ( my $tag = $parser->get_tag( "table" )) {
            if ( $self->_streq( $tag->[1]{class}, 'transfereeList' )) {
                $found = 1;
                last;
            }
        }

        # no transferees of this type
        if ( !$found ) {
            $self->_dprintf( "No category $ddlPaymentType beneficiaries found\n" );
            next;
        }

        while ( my $tag = $parser->get_tag( "td", "/tr", "/table" )) {
            last if ( $tag->[0] eq "/table" );
            if ( $tag->[0] eq "/tr" ) {
                if ( @beneficiary ) {
                    push @beneficiaries,
                      bless {
                             type => 'Beneficiary',
                             nick => $beneficiary[0],
                             lastused => $beneficiary[1],
                             ref => $beneficiary[2],
                             source => $beneficiary[3],
                             input => $beneficiary[4],
                             type => $ddlPaymentType,
                             account_no => 'hidden',
                             status => 'Active',
                            }, "Finance::Bank::IE::PTSB::Account";
                    @beneficiary = ();
                    $self->_dprintf( "Found beneficiary " . $beneficiaries[-1]->{nick} . "\n" );
                }
            } else {
                if ( $self->_streq( $tag->[1]{class}, 'transfereeListAction' )) {
                    $tag = $parser->get_tag( "input" );
                    push @beneficiary, $tag->[1]{id};
                } else {
                    push @beneficiary, $parser->get_trimmed_text( "/td" );
                }
            }
        }
    }

    \@beneficiaries;
}

=item * $self->add_beneficiary( $from_account, $to_account_details, $config )

 Add a beneficiary to $from_account.

=cut

sub add_beneficiary {
    my ( $self, $account_from, $to_account_no, $to_nsc, $to_ref, $to_nick,
         $confref ) =
      @_;

    return unless $to_nick;
    return unless $self->_get_payments_page( $account_from, $confref );

    # Create a new Third Party Transfer
    $self->_agent()->follow_link( text => 'Create a new Third Party Transfer' );
    $self->_save_page();

    return unless $self->_agent()->content() =~
      /CREATE A NEW THIRD PARTY TRANSFER/is;

    $self->_add_event_fields();
    $self->_agent()->submit_form(
                                 fields => {
                                            txtSortCode => $to_nsc,
                                            txtAccountCode => $to_account_no,
                                            txtBillRef => $to_ref,
                                            txtBillName => $to_nick,
                                            # if you have multiple accounts, ddlAccounts probably needs setting. Option value = NSC+Account_no!
                                            '__EVENTTARGET' => 'lbtnContinue',
                                            '__EVENTARGUMENT' => '',
                                           },
                                );
    $self->_save_page();

    return unless $self->_agent()->content() =~
      /CREATE A NEW THIRD PARTY TRANSFER.*STEP 2/si;

    $self->_add_event_fields();
    $self->_agent()->submit_form(
                                 fields => {
                                            'txtSMSCode' => '11111',
                                            '__EVENTTARGET' => 'lbtnContinue',
                                            '__EVENTARGUMENT' => '',
                                           },
                                );

    return unless $self->_agent()->content() =~
      /CREATE A NEW THIRD PARTY TRANSFER.*STEP 3/si;

    return 1;
}

=item * $receipt = $self->funds_transfer( $from, $to, $amt )

 Transfer C<$amt> from C<$from> to C<$to>. C<$from> has to match one
 of your account nicknames; C<$to> has to match a configured
 beneficiary.

=cut

sub funds_transfer {
    my $self = shift;
    my $account_from = shift;
    my $account_to = shift;
    my $amount = shift;
    my $confref = shift;

    # allow passing account object as destination. source is handled
    # by list_beneficiaries.
    if ( ref $account_to eq __PACKAGE__ . "::Account" ) {
        $account_to = $account_to->{nick};
    }

    $self->_dprintf( " funds_transfer: listing beneficiaries\n" );
    my $beneficiaries = $self->list_beneficiaries( $account_from, $confref );

    my $found;
    for my $beneficiary ( @{$beneficiaries}) {
        if ( $beneficiary->{ref} eq $account_to or
             $beneficiary->{nick} eq $account_to ) {
            if ( $found ) {
                $found = "ambiguous";
                last;
            }
            $found = $beneficiary;
        }
    }

    my $receipt;
    if ( !$found ) {
        $self->_dprintf( "no beneficiaries found for specified account" );
    } elsif ( ref $found ne "Finance::Bank::IE::PTSB::Account" ) {
        $self->_dprintf( "multiple matching beneficiaries found" );
    } else {
        if ( $found->{status} ne "Active" ) {
            $self->_dprintf( "found an account but it's not active" );
        } else {
            $self->_agent()->submit_form( fields => {
                                                     grpTransOther => $found->{input},
                                                     txtAmount => $amount,
                                                     '__EVENTTARGET' => 'lbtnPay',
                                                     '__EVENTARGUMENT' => '',
                                                    },
                                        );
            $self->_save_page();

            $receipt = $self->_agent()->content();

            if ( $receipt =~ /lbtnConfirm/s ) {
                $self->_agent()->submit_form( fields => {
                                                         '__EVENTTARGET' => 'lbtnConfirm',
                                                         '__EVENTARGUMENT' => '',
                                                        });
                $self->_save_page();
                $receipt = $self->_agent()->content();
                if ( $receipt !~ /successfully processed/si ) {
                    $self->_dprintf( "did not get transaction confirmation" );
                    $receipt = undef;
                }
            } else {
                $self->_dprintf( "did not get confirmation request page" );
                $receipt = undef;
            }
        }
    }

    return $receipt;
}

=item * $scrubbed = $self->_scrub_page( $content )

 Scrub the supplied content for PII.

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

    # This would be nicer with XPath. Alas, I tried XML::Xpath and the
    # world ended - it wanted to fetch a DTD from the web, which
    # didn't exist, and it took an awfully long time to figure that
    # out.
    my $output = "";
    my $parser = new HTML::TokeParser( \$content );
    while( my $token = $parser->get_token()) {
        my $token_string = $token->[-1];
        if ( $token->[0] eq 'T' ) {
            $token_string = $token->[1];
            if ( $token_string =~ /Your last successful logon/ ) {
                $token_string = "Your last successful logon was on 01 January 1970 at 00:00";
            }
        }

        if ( $token->[0] eq 'S' ) {
            # ASP state
            if ( $token->[1] eq 'input' ) {
                if ( $self->_streq( $token->[2]{name}, "__VIEWSTATE" ) or
                     $self->_streq( $token->[2]{name}, "__EVENTVALIDATION" ) or
                     $self->_streq( $token->[2]{name}, "PtsbCifNumber" ) or
                     $self->_streq( $token->[2]{name}, "PtsbBranchNumber" )
                   ) {
                    $token->[2]{value} = "";
                    $token_string = $self->_rebuild_tag( $token );
                }
            }

            if ( $token->[1] eq 'select' ) {
                if ( $self->_streq( $token->[2]{name}, 'ctl00$cphBody$ddlDestinationAccount' ) or
                   ( $self->_streq( $token->[2]{name}, 'ctl00$cphBody$ddlSourceAccount' ))) {
                    while ( my $account_token = $parser->get_token()) {
                        my $string = $account_token->[0] eq 'T' ? $account_token->[1] : $account_token->[-1];
                        if ( $account_token->[0] eq 'S' and $account_token->[1] eq 'option' ) {
                            my $val = $account_token->[2]{value};
                            if ( $val ne 'Please select' and $val !~ /^\d+$/ ) {
                                $account_token->[2]{value} = "0";
                                $string = $self->_rebuild_tag( $account_token );
                                $val = '0';
                            }
                            if ( $val ne 'Please select' ) {
                                $string .= "Account Type $val - 9999";
                            } else {
                                $string .= $parser->get_trimmed_text();
                            }
                            my $tag = $parser->get_tag( "/option" );
                            $string .= $tag->[-1];

                        }
                        $token_string .= $string;
                        last if ( $account_token->[0] eq 'E' and $account_token->[1] eq 'select' );
                    }
                }
            }

            if ( $token->[1] eq 'table' and $self->_streq( $token->[2]{class}, "transfereeList" )) {
                my $col = 0;
                while ( my $account_token = $parser->get_token()) {
                    my $string = $account_token->[0] eq 'T' ? $account_token->[1] : $account_token->[-1];
                    if ( $account_token->[1] eq 'td' and $account_token->[0] eq 'S' ) {
                        my $replacement = "";
                        if ( $col == 0 ) {
                            $replacement = "Recipient";
                        } elsif ( $col == 1 ) {
                            $replacement = "01/01/1970";
                        } elsif ( $col == 2 ) {
                            $replacement = "Reference";
                        } elsif ( $col == 3 ) {
                            $replacement = "Source A/C";
                        }
                        $string .= $replacement;
                        $parser->get_text();
                        $col++;
                    }
                    if ( $account_token->[0] eq 'E' and $account_token->[1] eq 'tr' ) {
                        $col = 0;
                    }
                    $token_string .= $string;
                    last if ( $account_token->[0] eq 'E' and $account_token->[1] eq 'table' );
                }
            }

            if ( $token->[1] eq 'span' ) {
                if ( $self->_streq( $token->[2]{id}, "lblTransferTo" )) {
                    $token_string .= "Recipient";
                    $parser->get_text();
                } elsif ( $self->_streq( $token->[2]{id}, "lblTranRef" )) {
                    $token_string .= "Reference";
                    $parser->get_text();
                } elsif ( $self->_streq( $token->[2]{id}, "lblFrAcc" )) {
                    $token_string .= "Source A/C";
                    $parser->get_text();
                } elsif ( $self->_streq( $token->[2]{id}, "lblAmount" )) {
                    $token_string .= "9999";
                    $parser->get_text();
                }
            }

            # should possibly do this within table class="statement"
            if ( $token->[1] eq 'a' and
                 defined( $token->[2]{href}) and
                 $token->[2]{href} =~ /^StateMini.aspx/ ) {

                # winging it a little here.
                my @replacements = ( "Account Type",
                                     9999, # account number
                                     99999.99, # balance
                                     99999.99, # balance
                                   );

                while ( my $account_token = $parser->get_token()) {
                    my $string = $account_token->[0] eq 'T' ? $account_token->[1] : $account_token->[-1];
                    if ( $account_token->[0] eq 'E' and $account_token->[1] eq 'tr' ) {
                        $token_string .= $string;
                        last;
                    }
                    if ( $account_token->[0] eq 'T' and $string !~ /^\s+$/ ) {
                        $string = shift @replacements;
                    }
                    if ( $account_token->[0] eq 'S' and
                         defined( $account_token->[2]{title} )) {
                        $account_token->[2]{title} = "";
                        $string = $self->_rebuild_tag( $account_token );
                    }
                    $token_string .= $string;
                }
            }
        }

        $output .= $token_string;
    }

    return $output;
}

sub _add_event_fields {
    my $self = shift;

    # these get added by javascript on the page
    my $form = $self->_agent()->current_form();
    for my $name qw( __EVENTTARGET __EVENTARGUMENT ) {
        if ( my $input = $form->find_input( $name )) {
            $input->readonly( 0 );
        } else {
            $input = new HTML::Form::Input( type => 'text',
                                            name => $name );
            $input->add_to_form( $form );
        }
    }
}

=back

=cut

package Finance::Bank::IE::PTSB::Account;

no strict;
sub AUTOLOAD { my $self=shift; $AUTOLOAD =~ s/.*:://; $self->{$AUTOLOAD} }

1;