The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package Ledger::Transaction;
BEGIN {
  $Ledger::Transaction::VERSION = '0.03';
}

use 5.010;
use DateTime;
use Log::Any '$log';
use Ledger::Util;
use Moo;

# VERSION

has date        => (is => 'rw', trigger => $reset_lineref_sub);
has seq         => (is => 'rw', trigger => $reset_lineref_sub);
has description => (is => 'rw', trigger => $reset_lineref_sub);
has entries     => (is => 'rw');
has lineref     => (is => 'rw'); # ref to line in journal->lines
has journal     => (is => 'rw');

sub BUILD {
    my ($self, $args) = @_;
    unless ($self->entries) {
        $self->entries([]);
    }
    if (!ref($self->date)) {
        $self->date(Ledger::Util::parse_date($self->date));
    }
    # re-set here because of trigger
    if (!defined($self->lineref)) {
        $self->lineref($args->{lineref});
    }
}

sub _die {
    my ($self, $msg) = @_;
    $self->journal->_die("Invalid transaction: $msg");
}

sub as_string {
    my ($self) = @_;
    my $rl = $self->journal->raw_lines;

    my $res = defined($self->lineref) ?
        ${$self->lineref} :
            $self->date->ymd . ($self->seq ? " (".$self->seq.")" : "") . " ".
                $self->description . "\n";
    for my $p (@{$self->entries}) {
        $res .= $p->as_string;
    }
    $res;
}

sub postings {
    my ($self) = @_;
    [grep {$_->isa('Ledger::Posting')} @{$self->entries}];
}

sub _bal_or_check {
    my ($self, $which) = @_;
    my $postings = $self->postings;

    my $num_p = 0;
    my $num_v = 0;
    my $num_vnb = 0;
    my $num_blank = 0;
    my %bal; # key=commodity
    for (@$postings) {
        $num_p++;
        $num_v++ if $_->is_virtual;
        my $is_vnb;
        if ($_->is_virtual && !$_->virtual_must_balance) {
            $num_vnb++;
            $is_vnb = 1;
        }
        $num_blank++ unless $_->amount;
        my $amt = $_->amount;
        next unless $amt;
        next if $is_vnb && $which eq 'check';
        my $number = $amt->[0];
        my $cmdity = $amt->[1];
        $bal{$cmdity} //= 0;
        $bal{$cmdity} += $number;
    }
    $log->tracef("num_p=%d, num_v=%d, num_blank=%d",
                 $num_p, $num_v, $num_blank);

    my @bal = map {[$bal{$_},$_]} grep {$bal{$_} != 0} keys %bal;
    if ($which eq 'check') {
        $self->_die("There must be at least 2 postings") if $num_p<2 && !$num_v;
        $self->_die("There must be at least 1 posting") if !$num_p;
        $self->_die("There must be at most 1 posting with blank amount")
            if $num_blank > 1;

        unless ($num_blank) {
            $self->_die(
                "doesn't balance (".
                    join(", ", map {Ledger::Util::format_amount($_)} @bal).
                        ")")
                if @bal;
        }
        return 1;
    } else {
        return [] if $num_blank;
        return \@bal;
    }
}

sub balance {
    my ($self) = @_;
    $self->_bal_or_check('bal');
}

sub is_balanced {
    my ($self) = @_;
    my $bal = $self->balance;
    @$bal == 0;
}

sub check {
    my ($self) = @_;
    $self->_bal_or_check('check');
}

1;
# ABSTRACT: Represent a Ledger transaction


=pod

=head1 NAME

Ledger::Transaction - Represent a Ledger transaction

=head1 VERSION

version 0.03

=head1 SYNOPSIS

=head1 DESCRIPTION

=for Pod::Coverage BUILD

=head1 ATTRIBUTES

=head2 date => DATETIME OBJ

=head2 seq => INT or undef

Sequence of transaction in a day. Optional.

=head2 description => STR

=head2 lineref => REF TO STR

=head2 entries => ARRAY OF OBJS

Array of L<Ledger::Posting> or L<Ledger::Comment>

=head2 journal => OBJ

Pointer to L<Ledger::Journal> object.

=head1 METHODS

=head2 new(...)

=head2 $tx->as_string()

=head2 $tx->balance() => [[SCALAR,COMMODITY], ...]

Return transaction's balance. If a transaction balances, this method should
return [].

=head2 $tx->is_balanced() => BOOL

Return true if transaction is balanced, or false if otherwise.

=head2 $tx->check()

=head2 $tx->postings()

=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__