package Ledger::Journal;
BEGIN {
  $Ledger::Journal::VERSION = '0.03';
}

use 5.010;
use locale;
use Array::Iterator;
use Log::Any '$log';
use Moo;
use Ledger::Comment;
use Ledger::Posting;
use Ledger::Pricing;
use Ledger::Transaction;
use Ledger::Util;
use List::Util qw(min max);
use Time::HiRes qw(gettimeofday tv_interval);

# VERSION

has raw_lines => (is => 'rw');
has entries   => (is => 'rw'); # array of L::Transaction, L::Comment, ...
has _filename => (is => 'rw'); # location for parsing error message
has _lineno   => (is => 'rw'); # idem

my $re_line      = qr/^(?:(?<tx>\d)|
                          (?<pricing>P)|
                          (?<comment>.?))/x;
my $re_tx        = qr/^(?<date>$re_date)
                      (\s+\((?<seq>\d+)\))?
                      (?:\s+(?<desc>.+?)
                          (?:\s\s+;(?<comment>.*))?)?/x;
my $re_idcomment = qr/^\s+;/x;
my $re_identline = qr/^\s+(?:(?<comment>;)|(?<posting>.?))/x;
my $re_posting   = qr/^\s+(?<acc>$re_account)
                      (?:\s{2,}(?<amount>$re_amount))?
                      \s*(?:;(?<comment>.*))?$/x;
my $re_pricing   = qr/^P\s+
                      (?<date>$re_date) \s+
                      (?<cmdity1>$re_cmdity) \s+
                      (?<n>$re_number) \s+
                      (?<cmdity2>$re_cmdity)
                      (?:\s;(?<comment>.*))?\s*$/x;

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

    if (!$self->raw_lines) {
        $self->raw_lines([]);
    }
    if (!$self->entries) {
        $self->entries([]);
    }
    $self->_parse;
}

sub _die {
    my ($self, $msg0) = @_;
    $msg0 .= "\n" unless $msg0 =~ /\n\z/;
    my $lineno = $self->_lineno;
    my $msg = join(
        "",
        "Ledger parse error",
        (defined($self->_filename) ? " in file ".$self->_filename : ""),
        (defined($lineno) ? " at line #$lineno" : ""),
        ": $msg0",
    );

    my $context = 2;
    if (defined $lineno) {
        for (max(0, $lineno-1-$context) ..
                 min(scalar(@{$self->raw_lines})-1, $lineno-1+$context)) {
            $msg .= ($_ == $lineno-1 ? "> " : "  ") . $self->raw_lines->[$_];
        }
    }

    die $msg;
}

sub as_string {
    my ($self) = @_;
    join "", map {$_->as_string} @{$self->entries};
}

sub _add_tx {
}

sub _parse {
    my ($self) = @_;
    $log->tracef('-> _parse()');
    my $t0 = [gettimeofday];

    my $rl = $self->raw_lines;
    my $ll = Array::Iterator->new($rl);
    my $i;
    while (defined(my $line = $ll->get_next)) {
        $i = $ll->current_index;
        $self->_lineno($i+1);
        $log->tracef("Read line #%d: %s", $i+1, $line);
        $line =~ $re_line or $self->_die("Can't be parsed");

        if (defined $+{comment}) {
            $log->tracef("Line is a comment");

            my $ls = $i;
            while (1) {
                $line = $ll->peek;
                last unless defined($line);
                last unless $line =~ $re_comment;
                $ll->next;
                # should update _lineno, but not used here
            }
            my $le = $i;
            $log->tracef("Collected comment lines: %s", [@{$rl}[$ls..$le]]);
            my $c = Ledger::Comment->new(
                    parent => $self, line_start => $ls, line_end => $le);
            push @{$self->entries}, $c;

        } elsif (defined $+{tx}) {
            $log->tracef("Line is a transaction");
            $self->_die("Invalid transaction syntax") unless $line =~ $re_tx;
            my %m=%+; $log->tracef("m=%s", \%m);
            my $tx;
            eval {
                $tx = Ledger::Transaction->new(
                    date => $+{date}, seq => $+{seq}, description=>$+{desc},
                    lineref => \$rl->[$i], journal => $self,
                );
            };
            $self->_die("Can't parse transaction: $@") if $@;
            while (1) {
                $line = $ll->peek;
                last if !defined($line);
                last unless $line =~ /^[ \t]/;
                $ll->next;
                $self->_lineno($ll->current_index + 1);
                $log->tracef("line(tx) = %s", $line);
                $self->_die("Can't be parsed") unless $line =~ $re_identline;
                if ($+{comment}) {

                    my $ls = $i;
                    while (1) {
                        $line = $ll->peek;
                        last unless defined($line);
                        last unless $line =~ $re_idcomment;
                        $ll->next;
                    }
                    my $le = $i;
                    $log->tracef("Found comment in tx: %s", @{$rl}[$ls..$le]);
                    my $c = Ledger::Comment->new(
                        parent => $tx, linerefs => [map {\$rl->[$_]} $ls..$le]);
                    push @{$tx->entries}, $c;

                } elsif ($+{posting}) {
                    $self->_die("Invalid posting syntax")
                        unless $line =~ $re_posting;
                    $log->tracef("Found posting: %s", $line);
                    my $p;
                    eval {
                        my ($is_virtual, $vmb);
                        my $acc     = $+{acc};
                        my $amount  = $+{amount};
                        my $comment = $+{comment};
                        #$log->tracef(">acc<=>%s<", $acc); # will catch a ws
                        $acc =~ s/\s+$//;
                        if ($acc =~ s/^\((.+)\)$/$1/) {
                            $is_virtual = 1;
                        } elsif ($acc =~ s/^\[(.+)\]$/$1/) {
                            $is_virtual = 1;
                            $vmb = 1;
                        }
                        #$log->tracef("Amount = %s, parsed = %s", $amount,
                        #             Ledger::Util::parse_amount($amount))
                        #    if $amount;
                        $p = Ledger::Posting->new(
                            account => $acc, amount => $amount,
                            comment => $comment, is_virtual => $is_virtual,
                            virtual_must_balance => $vmb,
                            tx => $tx, lineref => \$rl->[$i]);
                    };
                    $self->_die("Can't parse posting: $@") if $@;
                    push @{$tx->entries}, $p;

                }
            }
            $tx->check;
            push @{$self->entries}, $tx;
        } elsif (defined $+{pricing}) {
            $log->tracef("Line is a pricing");
            $self->_die("Invalid pricing syntax") unless $line =~ $re_pricing;
            my $tx;
            eval {
                $tx = Ledger::Pricing->new(
                    date => $+{date}, cmdity1=>$+{cmdity1}, n=>$+{n},
                    cmdity2=>$+{cmdity2}, comment => $+{comment},
                    lineref => \$rl->[$i], journal => $self,
                );
            };
            $self->_die("Can't parse pricing: $@") if $@;

        } else {
            $self->_die("Unknown entity");
        }
    }

    $log->tracef('<- _parse(), elapsed time=%.3fs',
                 tv_interval($t0, [gettimeofday]));
}

sub transactions {
    my ($self, $crit) = @_;
    my @res;
    for my $e (@{$self->entries}) {
        next unless $e->isa("Ledger::Transaction");
        if ($crit) {
            next unless $crit->($e);
        }
        push @res, $e;
    }
    \@res;
}

sub accounts {
    my ($self) = @_;
    my %acc;
    for my $tx (@{$self->entries}) {
        next unless $tx->isa('Ledger::Transaction');
        for my $p (@{$tx->entries}) {
            next unless $p->isa('Ledger::Posting');
            $acc{$p->account}++;
        }
    }
    [keys %acc];
}

sub add_transaction {
    my ($self, $tx) = @_;
    push @{$self->{entries}}, $tx;
}

1;
# ABSTRACT: Represent an Org document


=pod

=head1 NAME

Ledger::Journal - Represent an Org document

=head1 VERSION

version 0.03

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 ATTRIBUTES

=head2 raw_lines => ARRAY

Store the raw source lines.

=head2 entries => ARRAY

Transactions, pricing, and top-level entities.

=head1 METHODS

=for Pod::Coverage BUILD

=head2 new(raw_lines => [...])

Create object from string.

=head2 $journal->transactions([$criteria]) => \@tx

Return transaction objects. $criteria is optional, a coderef that can be used to
filter wanted transactions.

=head2 $journal->accounts() => \@acc

Return all accounts that are mentioned.

=head2 $journal->add_transaction($tx)

=head1 SEE ALSO

L<Ledger::Transaction>

=head1 AUTHOR

Steven Haryanto <stevenharyanto@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Steven Haryanto.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__