revbank/plugins/warnings
2022-08-29 17:50:12 +02:00

53 lines
1.4 KiB
Perl

#!perl
# The file format for 'revbank.warnings' is simply two whitespace separated
# columns: product id (or /regex/ for descriptions) and the warning text.
use Time::HiRes qw(sleep);
sub _read_warnings() {
return map {
my ($regex, $products, $text) = m[^
(?:
/((?>[^/\\]++|\\.)*+)/ # /regex with support for \/escaped\/ slashes/
| (\S+) # products IDs, comma separated
)
\s+
(.*)
]x;
$regex
? sub {
my ($id, $desc) = @_;
$desc =~ /$regex/i ? $text : ();
}
: sub {
my ($id, $desc) = @_;
(grep { $_ eq $id } split /,/, $products) ? $text : ();
}
} grep /\S/, grep !/^\s*#/, slurp 'revbank.warnings';
}
sub hook_add_entry($class, $cart, $entry, @) {
return if not $entry->has_attribute('product_id'); # skip unlisted, deposit, give, take
my @warnings = map {
$_->( $entry->attribute('product_id'), $entry->{description} )
} _read_warnings;
return if not @warnings;
my $text = join "\n", map ">> $_ <<", @warnings;
my $delay = 1.5 / length($text);
system "stty -echo 2>/dev/null";
print "\e[7m"; # reverse video
for my $c (split //, $text) {
print $c eq "\n" ? "\e[0m\n\e[7m" : $c;
sleep $delay;
}
print "\e[0m\n";
system "stty echo 2>/dev/null";
sleep .5;
}