revbank/plugins/statiegeld_tokens

#!perl

# TODO:
# voiding of tokens
# querying of tokens
# expiry of tokens

use List::Util;

my $ttl = 100 * 86400;  # expiry time in seconds
my $filename = "revbank.statiegeld";

sub _addon_accounts {
	my @accounts = @RevBank::Plugin::statiegeld::addon_accounts
		or die "statiegeld_tokens plugin requires statiegeld plugin";
	return @accounts;
}

sub _read {
	spurt $filename if not -e $filename;

	my %users_tokens;
	for (slurp $filename) {
		my ($username, @tokens) = split " ", $_;
		if (exists $users_tokens{$username}) {
			die "Corrupt data file $filename, $username listed twice";
		}

		my %by_id;
		for my $token (@tokens) {
			my (undef, $id) = split /:/, $token, 2;
			push @{ $by_id{$id} }, $token;
		}

		$users_tokens{$username} = \%by_id;
	}
	return \%users_tokens;
}

sub _write($username, $tokens_by_id, $create) {
	my @tokens = map @{ $tokens_by_id->{$_} }, sort keys %$tokens_by_id;
	my $new_line = @tokens == 0 ? undef : join(" ", $username, @tokens) . "\n";
	
	if ($create) {
		append $filename, $new_line if defined $new_line;
	} else {
		rewrite $filename, sub ($old_line) {
			# removes line from file if $new_line is undef
			return /(\S+)/ && $1 eq $username ? $new_line : $old_line;
		};
	}
}

sub _warn($message) {
	warn "\e[31;1mSorry,\e[0m $message\n";
}

sub _handle_undo($cart) {
	# Undoing properly is hard. We can easily void tokens, but we can't restore
	# them. That would requires duplicating all of the undo logic that exists
	# for account balances, but for tokens. Too much work for something that I
	# suspect would hardly be used anyway, so instead we'll just prohibit
	# undoing refunds.
	for my $entry ($cart->entries) {
		# Undo deposit refund: prohibit
		for my $contra ($entry->contras) {
			next if $contra->{amount} < 0;
			next if List::Util::none { $contra->{user} eq $_ } _addon_accounts;

			_warn "deposit refunds cannot be undone.";
			die "ROLLBACK_UNDO";
		}

		# Undo buying: void specific tokens
		my $undo_tid = $entry->attribute('undo_transaction_id')
			or die "Plugin error: broken '-undo' transaction";

		rewrite $filename, sub ($line) {
			my ($username, @tokens) = split " ", $line;
			@tokens = grep {
				my ($meta, $id) = split /:/, $_;
				my (undef, undef, $tid) = split /\./, $meta;

				$tid ne $undo_tid
			} @tokens;

			return @tokens ? join(" ", $username, @tokens) : undef;
		};
	}
}

sub hook_checkout($class, $cart, $username, $transaction_id, @) {
	if ($username eq '-undo') {
		_handle_undo($cart);
		return;
	}

	# Read data
	my $tokens_by_id = _read->{$username};
	my $is_new = !defined $tokens_by_id;
	$tokens_by_id = {} if $is_new;

	my $products = RevBank::Plugin::products::_read_products();
	my $tokens_changed = 0;

	# Products bought: add tokens
	for my $entry ($cart->entries('addons')) {
		for my $addon_id (@{ $entry->attribute('addons') }) {
			my $addon = $products->{"+$addon_id"} // $products->{$addon_id};

			next
				if $addon->{percent}
				or (List::Util::none { $addon->{contra} eq $_ } _addon_accounts)
				or $addon->{price} <= 0;

			for (1 .. $entry->quantity) {
				my $token = join(":",
					join(".", time(), time() + $ttl, $transaction_id),
					$addon->{id}
				);
				push @{ $tokens_by_id->{$addon->{id}} }, $token;
			}
			$tokens_changed++;
		}
	}

	# Products (containers) returned: void tokens in FIFO order
	my $cart_changed = 0;
	my %warnings_by_id;
	my %had_num_tokens_by_id = map { $_ => scalar @{ $tokens_by_id->{$_} } } keys %$tokens_by_id;

	ENTRY: for my $entry ($cart->entries('plugin')) {
		$entry->attribute('plugin') eq 'statiegeld' or next;

		my $id = $entry->attribute('addon_id');
		my $available = @{ $tokens_by_id->{$id} // [] };

		if ($available < $entry->quantity) {

			if ($available == 0) {
				$cart->delete($entry);
				$warnings_by_id{$id}++;
				next ENTRY;
			}
			$entry->quantity($available);
			$warnings_by_id{$id}++;
		}

		splice @{ $tokens_by_id->{$id} }, 0, $entry->quantity;
		$tokens_changed++;
	}
	for my $id (keys %warnings_by_id) {
		my $addon = $products->{"+$id"} // $products->{$id};
		my $avail = $had_num_tokens_by_id{$id};
		my $only = $avail ? "only $avail" : "0";
		_warn "you have $only deposit tokens of type $id ($addon->{description})";
	}

	# Store data
	_write $username, $tokens_by_id, $is_new if $tokens_changed;

	return ABORT if %warnings_by_id and not $cart->size;
	return;
}