#!/usr/bin/perl
=pod

=head1 NAME

Glitnir - A Perl module for accessing Glitnir's online bank system

=head1 SYNOPSIS

    use Glitnir;

    my $glitnir = Glitnir->new();

    # Get a hash listing today's exchange rates
    my $rates = $glitnir->exchange_rates();

    # Logging in
    $glitnir->login($user, $password);      # Set programmatically
    $glitnir->login($glitnir->get_login()); # .. or ask the user

    # Get a reference to a hash of accounts
    my $accounts = $glitnir->accounts();
    
    # Get a reference to a list of transactions
    my $transactions = $glitnir->transactions('543-26-12345');

    # Same, for a credit-card (note the format may differ from bank statmens)
    my $transactions = $glitnir->transactions('5432100000199909');

=head1 DESCRIPTION

This object provides a high-level programmatic interface to Glitnir's
online mobile banking system at http://m.glitnir.is/.

Obviously if Glitnir change their HTML then some or all of this stuff 
might break.  I've attempted to document the current state of things
within this module, however exploring the returned values using something
like Data::Dumper and building lots of sanity checks into any programs
using this code is highly recommended.

=head1 ERROR HANDLING

This module uses perl "exceptions" to handle errors, any 
method may die if it fails to do it's job.  Use eval blocks to catch
such errors and handle them if you don't want errors to abort your
programs:

   eval { # try

      ... some Glitnir calls ...

   };
   if ($@) # catch
   {
      ... handle exception $@ ...
   }

=head1 AUTHOR AND LICENSE

This module was written by Bjarni R. Einarsson, <http://bre.klaki.net/>.

It may be freely used and distributed under the same terms as Perl itself.

=head1 METHODS

=over

=cut
package Glitnir;
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Cookies;

=pod

=item $glitnir = Glitnir->B<new>( %args );

Creates a new object representing a session within the Glitnir
home-banking system.  Optionally, it can attempt to resume a 
previous session.  Arguments:

  debug => 1         # Enable debug messages to STDERR
  base => $hostname  # Use something other than m.glitnir.is
  session_id => $s   # Resume an old session
  logged_in => 1     # Assume resumed session is logged-in

=cut
sub new {
    my ($proto, %args) = @_;
    my $class = ref($proto) || $proto;

    my $cookie_jar = new HTTP::Cookies;
    my $ua = LWP::UserAgent->new;
    $ua->agent("Glitnir.pm; http://bre.klaki.net/programs/Glitnir/");
    $ua->timeout(10);
    $ua->env_proxy;
    $ua->cookie_jar($cookie_jar);
    $ua->default_headers->push_header('Accept' => "*/*");

    my $self = {
        base => $args{base} || 'm.glitnir.is',
        page => {
            front => 'https://_BASE_/',
            login => 'https://_BASE_/Netbanki/Default.aspx',
            gengi => 'https://_BASE_/Markadir/Gjaldmidlar.aspx',
            banki => 'https://_BASE_/Netbanki/Default.aspx',
        },
        session_id => undef,
        cache      => { },
        logged_in  => $args{logged_in},
        ua         => $ua,     
        debug      => $args{debug},
    };
    bless ($self, $class);

    # Get a session...
    $self->set_session_id($args{session_id});

    return $self;
}

=pod

=item $rates = $glitnir->B<exchange_rates>();

Returns a reference to a hash of exchange rates.  The structure returned
looks like this:

    {
        "USD" => {
            Kaup => 74,
            Sala => 75,
            ...
        },
        "EUR" => {
            ...
        }
    }

Note that the actual currencies described and the field names within 
each hash are determined by the info in the Glitnir mobile bank.

The code is written so that if they reorder their tables, it shouldn't
matter as long as the columns retain the same descriptive headings 
(Kaup, Sala, ...).  However, if they change their naming conventions
all bets are off.

=cut
sub exchange_rates
{
    my ($self) = @_;
    return $self->{cache}->{exchange_rates} if ($self->{cache}->{exchange_rates});

    my $table = table(content($self->get_page($self->{page}->{gengi}))); 

    my $labels = shift(@$table);
    $labels->[0] = undef;
    $labels->[1] = undef;

    return ($self->{cache}->{exchange_rates} = table_to_hash(
                key    => 0,
                labels => $labels,
                table  => $table
           ));
}

=pod

=item $transactions = $glitnir->B<transactions>( $account );

Returns a reference to a list of transactions rates.  The $account
variable may either be one of the hashes returned by the B<accounts()>
method, or an account number (123-45-657000). 

The structure returned looks like this:

    [
        [ "dd.mm", "description", "amount"  ],
        [ "dd.mm", "description", "amount"  ],
        ...
    ] 

Note that column order is determined by the Glitnir mobile bank, if 
they reorder things, programs using this method will break.

=cut
sub transactions
{
    my ($self, $account) = @_;
    if (ref($account) !~ /HASH/i)
    {
        $account = $self->accounts()->{$account};
    }
    die "Invalid account" unless ($account && $account->{url});

    return table(content($self->get_page($account->{url}))); 
}

=pod

=item $accounts = $glitnir->B<accounts>();

Returns a reference to a hash of hashes, each hash describing a bank
account or credit-card.

The structure returned looks like this:

    { 
        "012-23-4234" => {
            nr       => "012-23-4234",    
            url      => $path_to_transaction_page,
            name     => $some_text,
            balance  => $number,
            currency => $currency_TLA,
        },
        ...
    } 

Credit-card accounts have neither a balance nor a currency and
their identifying numbers are 16 digits long.

=cut
sub accounts
{
    my ($self) = @_;
    die "Not logged in" unless ($self->{logged_in});
    return $self->{cache}->{accounts} if ($self->{cache}->{accounts});

    my $data = content($self->get_page($self->{page}->{banki}));

    my $base_url = $self->{page}->{banki};
    $base_url =~ s/[^\/]+$//;

    my %accounts = ( );
    foreach my $d ($data =~ m/<li[^>]*>(.*?yfirlit.*?)<\/li[^>]*>/g)
    {
        $d =~ s/<br[^>]*>/ /g;
        $d =~ s/&nbsp;/ /g;

        my %acc = ( url => '', name => '' );
        $acc{url} = $base_url.$1 if ($d =~ /<a[^>]*href=['"]?([^'"]+)[^>]*>/);
        $acc{nr} = $1 if ($acc{url} =~ /r=([0-9-]+)/);
        $acc{name} = $1 if ($d =~ /<a[^>]*>(.*?)<\/a/);
        $acc{balance} = $1 if ($d =~ /\(([0-9\.,-]+)\s/);
        $acc{currency} = $1 if ($d =~ /\([0-9\.,-]+\s(\S+)\)/);
        $acc{balance} =~ s/\.//g if (defined $acc{balance});

        $accounts{$acc{nr}} = \%acc if ($acc{nr});
    } 

    return ($self->{cache}->{accounts} = \%accounts);
}

=pod

=item ($user, $pass) = $glitnir->B<get_login>();

Prompts the user for a username and password, using stty to keep from
echoing the password back.  Useful for interactive console apps, other
programs will want to implement their own.

=cut
sub get_login
{
    my ($self) = @_;

    $|=1;
    print STDERR "Username: "; my $user = <STDIN>; chomp $user;
    system("stty -echo");
    print STDERR "Password: "; my $pass = <STDIN>; chomp $pass; print STDERR "\n";
    system("stty echo");
    
    return ($user, $pass);
}

=pod

=item $glitnir->B<login>($user, $pass);

Attempts to log the user on to the Glitnir mobile bank.
Should die on failure.

=cut
sub login
{
    my ($self, $user, $pass) = @_;
    die "Need username and password" unless ($user && $pass);

    # Scan form for input names
    my $form = $self->get_page($self->{page}->{login});
    my $login_var  = find_form_field("text",     "name",  $form);
    my $pass_var   = find_form_field("password", "name",  $form);
    my $submit_var = find_form_field("submit",   "name",  $form);
    my $submit_val = find_form_field("submit",   "value", $form);
    my %hidden     = find_hidden_form_fields($form);
    die "Couldn't parse login form: $form" unless ($login_var && $pass_var);

    my $c = $self->post_page($self->{page}->{login}, { 
                                $login_var  => $user,
                                $pass_var   => $pass,
                                $submit_var => $submit_val,
                                %hidden
                            });

    die "Not logged in" if ($c =~ /errorDiv/);

    $self->{logged_in} = 1;
    $self->clear_cache();
}

=pod

=item $session_id = $glitnir->B<session_id>();

Returns the current session ID.  This can be saved and then passed
back to the B<new()> method later (but not too late) to resume a
session.

=cut
sub session_id { return $_[0]->{session_id} }

=pod

=item $logged_in = $glitnir->B<logged_in>();

Returns non-zero if the session has successfully logged in.

=cut
sub logged_in  { return $_[0]->{logged_in} }

=pod

=item $glitnir->B<ping>();

Check whether a session is still alive and valid.  Will die 
if it isn't.

=cut
sub ping
{
    my ($self) = @_;
    $self->get_page($self->{page}->{front}, no_cache => 1 ); 
}

=pod

=item $glitnir->B<clear_cache>();

Clear the internal cache, forcing all queries to refresh data from 
the Glitnir site.

=cut
sub clear_cache
{
    my ($self) = @_;
    $self->{cache} = { };
}

=pod

=item $glitnir->B<new_session>();

Close the current session, clear the cache and create a new one.

=cut
sub new_session
{
    my ($self) = @_;
    $self->{cache} = { };
    $self->{logged_in} = undef;
    $self->{session_id} = undef;
    $self->{base} =~ s/\/[^\/]+$//;
    $self->set_session_id();
}


##[ Internal methods ]##########################################################

sub get_page
{
    my ($self, $url, %args) = @_;

    my $base = $self->{base};
    $url =~ s/_BASE_/$base/g; 

    return $self->{cache}->{$url} if (!$args{no_cache} && $self->{cache}->{$url});

    my $ua = $self->{ua};
    $ua->max_redirect(0); 
    print STDERR "GET $url\n" if ($self->{debug});
    my $response = $ua->get($url);

    die $url.": ".$response->status_line() 
      unless ($args{error_ok} || $response->is_success());

    my $content = $response->content();
    $self->{cache}->{$url} = $content; 
    return $content;
}

sub post_page
{
    my ($self, $url, @post) = @_;
    my $ua = $self->{ua};
    my $base = $self->{base};

    $ua->max_redirect(0); 
    $url =~ s/_BASE_/$base/g; 

    print STDERR "POST $url\n" if ($self->{debug});
    my $response = $ua->post($url, @post);
    die $url.": ".$response->status_line() unless ($response->is_success());

    return $response->content();
}

sub set_session_id
{
    my ($self, $sid) = @_;
    if ($sid)
    {
        # We were given a session ID, so just use it.
        $self->{session_id} = $sid;
        $self->{base} .= $sid;
        return;
    }
    else
    {
        # Else, get a new session from Glitnir.
        my $ua = $self->{ua};
        $ua->max_redirect(0); 

        my $content = $self->get_page($self->{page}->{front}, error_ok => 1 );
        my $base = $self->{base};
        if ($content =~ /$base(\/\(.*\))\//)
        {
            $self->{session_id} = $1;
            $self->{base} .= $1;
            return;
        }
        die "Failed to get session ID from $base\n";
    }
}


##[ Helpers ]##################################################################

sub content
{
    my ($data) = @_;
    $data =~ s/^.*id=.?Content[^>]*>(.*)<div[^>]+id=.?(Footer|Nav).*$/$1/si;
    return $data;
}

sub table_to_hash
{
    my (%args) = @_;
    my $key_col = $args{key};    
    my $labels  = $args{labels} || die "Need labels";    
    my $table   = $args{table}  || die "Need table";

    my %hash = ( );
    foreach my $line (@$table)
    {
        my %h = ( );
        my $key = $line->[$key_col];
        for (my $i = 0; $i < @$labels; $i++)
        {
            $h{$labels->[$i]} = $line->[$i] if ($labels->[$i]);
        }
        $hash{$key} = \%h;
    }
    return \%hash;
}

sub table
{
    my ($data) = @_;
    if ($data =~ /<table[^>]*>(.*?)<\/table/si)
    {
        my $table = $1;
        my @table;
        foreach my $tr ($table =~ /<tr[^>]*>(.*?)<\/tr/g)
        {
            my @tr;
            foreach my $td ($tr =~ /<t[dh][^>]*>\s*(.*?)\s*<\/t[dh]/g)
            {
                if ($td =~ /^[0-9\,,-]+$/)
                {
                    $td =~ s/\.//g;
                    $td =~ s/,/./g;
                }
                push @tr, $td; 
            } 
            push @table, \@tr;
        } 
        return \@table;
    }
    return undef;
}

sub find_form_field
{
    my ($type, $what, $form) = @_;
    my $input = $1 if ($form =~ /<input([^>]*\s+type=.?$type[^>]*)>/is);
    my $data = $2 if ($input =~ /(^|\s)$what=["']?([^"'>]*)/i); 
    return $data; 
}

sub find_hidden_form_fields
{
    my ($form) = @_;
    my %hidden = ( ); 
    while ($form =~ s/<input([^>]*\s+type=.?hidden[^>]*)>//is)
    {
        my $input = $1;
        my $n = $2 if ($input =~ /(^|\s)name=["']?([^"'>]*)/i); 
        my $v = $2 if ($input =~ /(^|\s)value=["']?([^"'>]*)/i); 
        $hidden{$n} = $v if ($n);
    }
    return %hidden;
}


1;
=pod

=back

=head1 BUGS

This is all a hack and any changes to the mobile bank may break the
functionality of this module and programs based on it.  However, I
hope it is a useful proof-of-concept demonstrating to the bank how
useful (and simple!) it would be to provide a proper web-service API 
to 3rd party developers.

Transferring money between accounts is not supported.  This is a 
deliberate omission, as I currently have no use for such features 
and don't intend to assist cyber-criminals by writing their tools 
for them.

=cut
__DATA__
# vi:ts=4 expandtab