File Coverage

blib/lib/Finance/Bank/Postbank_de/Account.pm

Criterion	Covered	Total	%
statement	127	135	94.0
branch	57	70	81.4
condition	18	21	85.7
subroutine	14	14	100.0
pod	4	7	57.1
total	220	247	89.0

package Finance::Bank::Postbank_de::Account;
use 5.006;
use strict;
use warnings;
use Carp qw(croak);
use POSIX qw(strftime);
use Moo 2;

our $VERSION = '0.57';

has [
    'number',
    'balance',
    'balance_unavailable',
    'balance_prev',
    'transactions_future',
    'iban',
    'blz',
    'account_type',
    'name',
    ] => ( is => 'rw' );

around BUILDARGS => sub {
  my ($orig, $class,%args) = @_;

  if( exists $args{ number } and exists $args{ kontonummer }
      and $args{ number } ne $args{ kontonummer } ) {
      croak "'kontonummer' is '$args{kontonummer}' and 'number' is '$args{ number }'";
  };
  my $num = delete $args{number} || delete $args{kontonummer};
  $args{ number } = $num
      if defined $num;

  $orig->( $class, %args );
};

{ no warnings 'once';
*kontonummer = *number;
}

our %safety_check = (
  name		=> 1,
  kontonummer	=> 1,
);

our %tags = (
  #Girokonto => [qw(Name BLZ Kontonummer IBAN)],
  "gebuchte Ums\x{00E4}tze" => [qw(Name BLZ Kontonummer IBAN)],
  Tagesgeldkonto => [qw(Name BLZ Kontonummer IBAN)],
  Sparcard => [qw(Name BLZ Kontonummer  IBAN)],
  Sparkonto => [qw(Name BLZ Kontonummer  IBAN)],
  Kreditkarte => [qw(Name BLZ Kontonummer IBAN)],
  '' => [qw(Name BLZ Kontonummer IBAN)],
);

our %totals = (
  "gebuchte Ums\x{00E4}tze" => [
      [qr'^Aktueller Kontostand' => 'balance'],
      [qr'^Summe vorgemerkter Ums.tze' => 'transactions_future'],
      [qr'^Davon noch nicht verf.gbar' => 'balance_unavailable'],
  ],
  Sparcard => [[qr'Aktueller Kontostand' => 'balance'],],
  Sparkonto => [[qr'Aktueller Kontostand' => 'balance'],],
  Tagesgeldkonto => [[qr'Aktueller Kontostand' => 'balance'],],
  "" => [
      [qr'^Aktueller Kontostand' => 'balance'],
      [qr'^Summe der Ums.tze in den n.chsten 14 Tagen' => 'transactions_future'],
      [qr'^Davon noch nicht verf.gbar' => 'balance_unavailable'],
  ],
);

our %columns = (
  qr'Buchungsdatum'			=> 'tradedate',
  qr'Wertstellung'		=> 'valuedate',
  qr'Umsatzart'			=> 'type',
  qr'Buchungsdetails'		=> 'comment',
  qr'Auftraggeber'		=> 'sender',
  qr'Empf.nger'			=> 'receiver',
  qr"Betrag \((?:\x{20AC}|\x{80})\)"		=> 'amount',
  qr"Saldo \((?:\x{20AC}|\x{80})\)"		=> 'running_total',
);

sub parse_date {
  my ($self,$date) = @_;
  $date =~ /^(\d{2})\.(\d{2})\.(\d{4})$/
    or die "Unknown date format '$date'. A date must be in the format 'DD.MM.YYYY'\n";
  $3.$2.$1;
};

sub parse_amount {
  my ($self,$amount) = @_;
  # '¿ 5.314,05'
  die "String '$amount' does not look like a number"
    unless $amount =~ /^(-?)(?:\s*\x{20AC}\s*|\s*\x{80}\s*|\s*\x{A4}\s*)?([0-9]{1,3}(?:\.\d{3})*,\d{2})(?:\s*\x{20AC}|\s*\x{80})?$/;
  $amount = ($1||'') . $2;
  $amount =~ tr/.//d;
  $amount =~ s/,/./;
  $amount;
};

sub slurp_file {
  my ($self,$filename) = @_;
  local $/ = undef;
  open my $fh, "< $filename"
    or croak "Couldn't read from file '$filename' : $!";
  binmode $fh, ':encoding(UTF-8)';
  <$fh>;
};

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

  # If $self is just a string, we want to make a new class out of us
  $self = $self->new
    unless ref $self;
  my $filename = $args{file};
  my $raw_statement = $args{content};
  if ($filename) {
    $raw_statement = $self->slurp_file($filename);
  } elsif (! defined $raw_statement) {
    croak "Need an account number if I have to retrieve the statement online"
      unless $args{number};
    croak "Need a password if I have to retrieve the statement online"
      unless exists $args{password};
    my $login = $args{login} || $args{number};

    require Finance::Bank::Postbank_de;
    return Finance::Bank::Postbank_de->new( login => $login, password => $args{password}, past_days => $args{past_days} )->get_account_statement;
  };

  croak "Don't know what to do with empty content"
    unless $raw_statement;

  my @lines = split /\r?\n/, $raw_statement;
  croak "No valid account statement: '$lines[0]'"
    unless $lines[0] =~ /^Umsatzauskunft;$/;
  shift @lines;

  my $account_type = '';
  #my $account_type = $1;
  #if( ! exists $tags{ $account_type }) {
  #  $account_type =~ s!([^\x00-\x7f])!sprintf '%08x', ord($1)!ge;
  #  croak "Unknown account type '$account_type' (" . (join ",",keys %tags) . ")"
  #    unless exists $tags{$account_type};
  #};
  #$self->account_type($account_type);

  # Name: PETRA PFIFFIG
  #for my $tag (@{ $tags{ $self->account_type }||[] }) {
  my $sep = ";";
  if( $lines[0] =~ /([\t;])/) {
    $sep = $1;
  };
  for my $tag (@{ $tags{ $account_type }||[] }) {
    $lines[0] =~ /^\Q$tag\E$sep(.*?)$sep?$/
      or croak "Field '$tag' not found in account statement ($lines[0])";
    my $method = lc($tag);
    my $value = $1;

    # special check for special fields:
    croak "Wrong/mixed account $method: Got '$value', expected '" . $self->$method . "'"
      if (exists $safety_check{$method} and defined $self->$method and $self->$method ne $value);

    $self->$method($value);
    shift @lines;
  };


  while ($lines[0] !~ /^\s*$/) {
    my $line = shift @lines;
    my ($method,$balance);
    for my $total (@{ $totals{ $account_type }||[] }) {
      my ($re,$possible_method) = @$total;
      if ($line =~ /$re$sep\s*(?:(?:(\S+)\s*(?:\x{20AC}|\x{80}))|(null))$sep$/) {
        $method = $possible_method;
        $balance = $1 || $2;
        if ($balance =~ /^(-?[0-9.,]+)\s*$/) {
          $self->$method( ['????????',$self->parse_amount($balance)]);
        } elsif ('null' eq $balance) {
          $self->$method( ['????????',$self->parse_amount("0,00")]);
        } else {
          die "Invalid number '$balance' found for $method in '$line'";
        };
      };
    };
    if (! $method) {
        $account_type =~ s!([^\x00-\x7f])!sprintf '%08x', ord($1)!ge;
        $line =~ s!([^\x00-\x7f])!sprintf '%08x', ord($1)!ge;
        croak "No summary found in account '$account_type' statement ($line)";
    };
  };

  $lines[0] =~ m!^\s*$!
    or croak "Expected an empty line after the account balances, got '$lines[0]'";
  shift @lines;

  # Now skip over the transactions in the future
  while( $lines[0] !~ /^gebuchte Ums.tze/ ) {
    shift @lines;
  };
  shift @lines;

  # Now parse the lines for each cashflow :
  $lines[0] =~ /^Buchungsdatum${sep}Wertstellung${sep}Umsatzart/
    or croak "Couldn't find start of transactions ($lines[0])";

  my (@fields);
  COLUMN:
  for my $col (split /$sep/, $lines[0]) {
    for my $target (keys %columns) {
      if ($col =~ m!^["']?$target["']?$!) {
        push @fields, $columns{$target};
        next COLUMN;
      };
    };
    die "Unknown column '$col' in '$lines[0]'";
  };
  shift @lines;

  my (%convert) = (
    tradedate => \&parse_date,
    valuedate => \&parse_date,
    amount => \&parse_amount,
    running_total => \&parse_amount,
  );

  my @transactions;
  my $line;
  for $line (@lines) {
    next if $line =~ /^\s*$/;
    my (@row) = split /$sep/, $line;
    scalar @row == scalar @fields
      or die "Malformed cashflow ($line): Expected ".scalar(@fields)." entries, got ".scalar(@row);

    for (@row) {
      $_ = $1
          if /^\s*["']\s*(.*?)\s*["']\s*$/;
    };

    my (%rec);
    @rec{@fields} = @row;
    for (keys %convert) {
      $rec{$_} = $convert{$_}->($self,$rec{$_});
    };

    push @transactions, \%rec;
  };

  # Filter the transactions
  $self->{transactions} = \@transactions;

  $self
};

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

  my ($start_date,$end_date);
  if (exists $args{on}) {

    croak "Options 'since'+'upto' and 'on' are incompatible"
      if (exists $args{since} and exists $args{upto});
    croak "Options 'since' and 'on' are incompatible"
      if (exists $args{since});
    croak "Options 'upto' and 'on' are incompatible"
      if (exists $args{upto});
    $args{on} = strftime('%Y%m%d',localtime())
      if ($args{on} eq 'today');
    $args{on} =~ /^\d{8}$/ or croak "Argument {on => '$args{on}'} dosen't look like a date to me.";

    $start_date = $args{on} -1;
    $end_date = $args{on};
  } else {
    $start_date = $args{since} || "00000000";
    $end_date = $args{upto} || "99999999";
    $start_date =~ /^\d{8}$/ or croak "Argument {since => '$start_date'} dosen't look like a date to me.";
    $end_date =~ /^\d{8}$/ or croak "Argument {upto => '$end_date'} dosen't look like a date to me.";
    $start_date < $end_date or croak "The 'since' argument must be less than the 'upto' argument";
  };

  # Filter the transactions
  grep { $_->{tradedate} > $start_date and $_->{tradedate} <= $end_date } @{$self->{transactions}};
};

sub value_dates {
  my ($self) = @_;
  my %dates;
  $dates{$_->{valuedate}} = 1 for $self->transactions();
  sort keys %dates;
};

sub trade_dates {
  my ($self) = @_;
  my %dates;
  $dates{$_->{tradedate}} = 1 for $self->transactions();
  sort keys %dates;
};

1;
__END__