revbank/plugins/products

#!perl

HELP1 "<productID>" => "Add a product to pending transaction";

my $filename = 'revbank.products';
my $default_contra = '+sales/products';

sub read_products() {
    state %products;
    state $mtime;

    return \%products if $mtime and $mtime == -M $filename;
    %products = ();
    $mtime = -M $filename;

    my $linenr = 0;
    my $warnings = 0;

    for my $line (slurp $filename) {
        $linenr++;

        next if $line =~ m[
            ^\s*\#    # comment line
            |
            ^\s*$     # empty line, or only whitespace
        ]x;

        my @split = RevBank::Prompt::split_input($line);

        if (not @split or ref $split[0] or grep /\0/, @split) {
            warn "Invalid value in $filename line $linenr.\n";
            next;
        }

        my ($ids, $p, $desc, @extra) = @split;

        my @addon_ids;
        my %tags;

        my $compat = 0;
        if (@split == 1 and ref $split[0]) {
            $compat = 1;
        } else {
            for (@extra) {
                if (/^\+(.*)/) {
                    push @addon_ids, $1;
                } elsif (/^\#(\w+)(=(.*))?/) {
                    $tags{$1} = $2 ? $3 : 1;
                } else {
                    $compat = 1;
                    last;
                }
            }
        }

        if ($compat) {
            $warnings++;
            warn "$filename line $linenr: can't parse as new format; assuming old format.\n" if $warnings < 4;
            warn "Too many warnings; suppressing the rest. See UPGRADING.md for instructions.\n" if $warnings == 4;

            ($ids, $p, $desc) = split " ", $line, 3;

            @addon_ids = ();
            unshift @addon_ids, $1 while $desc =~ s/\s+ \+ (\S+)$//x;
        }

        my @ids = split /,/, $ids;

        $p ||= "invalid";
        $desc ||= "(no description)";

        my ($price, $contra) = split /\@/, $p, 2;

        my $sign = $price =~ s/^-// ? -1 : 1;
        my $percent = $price =~ s/%$//;

        if ($percent) {
            if (grep !/^\+/, @ids) {
                warn "Percentage invalid for non-addon at $filename line $linenr.\n";
                next;
            }
            $price = 0 + $price;
        } else {
            $price = eval { parse_amount($price) };
            if (not defined $price) {
                warn "Invalid price for '$ids[0]' at $filename line $linenr.\n";
                next;
            }
        }
        for my $id (@ids) {
            warn "Product '$id' redefined at $filename line $linenr (original at line $products{$id}{line}).\n" if exists $products{$id};

            $products{$id} = {
                id          => $ids[0],
                price       => $sign * $price,
                percent     => $percent,
                description => $desc,
                contra      => $contra || $default_contra,
                _addon_ids  => \@addon_ids,
                line        => $linenr,
                tags        => \%tags,
            };
        }
    }

    PRODUCT: for my $product (values %products) {
        my %ids_seen = ($product->{id} => 1);
        my @addon_ids = @{ $product->{_addon_ids} };

        while (my $addon_id = shift @addon_ids) {
            $addon_id = "+$addon_id" if exists $products{"+$addon_id"};

            if ($ids_seen{$addon_id}++) {
                warn "Infinite addon loop for '$product->{id}' at $filename line $product->{line}.\n";
                next PRODUCT;
            }

            my $addon = $products{$addon_id};
            if (not $addon) {
                warn "Addon '$addon_id' does not exist for '$product->{id}' at $filename line $product->{line}.\n";
                next PRODUCT;
            }

            push @{ $product->{addons} }, $addon;
            push @addon_ids, @{ $addon->{_addon_ids} };
        }
    }

    return \%products;
}

sub command :Tab(&tab) ($self, $cart, $command, @) {
    $command =~ /\S/ or return NEXT;
    $command =~ /^\+/ and return NEXT;

    my $products = read_products;
    my $product = $products->{ $command } or return NEXT;
    my $price = $product->{price};

    my $contra_desc = "\$you bought $product->{description}";

    my @addons = @{ $product->{addons} // [] };

    my $display = undef;
    $display = "Product"       if @addons and $price->cents > 0;
    $display = "Reimbursement" if @addons and $price->cents < 0;

    my $entry = $cart->add(
        -$price,
        $product->{description},
        {
            product_id => $product->{id},
            plugin => $self->id,
            product => $product,
            deduplicate => join("/", $self->id, $product->{id}),
        }
    );
    $entry->add_contra(
        $product->{contra},
        +$price,
        $contra_desc,
        $display
    );

    for my $addon (@addons) {
        my $addon_price = $addon->{price};
        if ($addon->{percent}) {
            my $sum = List::Util::sum map {
                $_->{amount}
            } grep {
                $_->{user} eq $addon->{contra}
            } $entry->contras;

            $addon_price = $addon_price / 100 * $sum;
        }

        $entry->amount( $entry->amount - $addon_price );

        $entry->add_contra(
            $addon->{contra},
            $addon_price,
            "$addon->{description} ($contra_desc)",
            $addon->{description}
        );
    }

    return ACCEPT;
}

sub tab {
    return grep !/^\+/, grep /\D/, keys %{ read_products() };
}