eed0db7897
The signatures feature has been "experimental" since Perl 5.20 (May 2014), but expected to stay. After 8 years I'm ready to take the risk :) Have added Perl v5.28 (June 2018) as the minimum requirement, even though the current revbank should work with 5.20, to see if this bothers any users. Perl v5.28 is in Debian "buster", which is now oldstable.
54 lines
1.5 KiB
Perl
54 lines
1.5 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() {
|
|
open my $fh, 'revbank.warnings' or die $!;
|
|
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*#/, readline $fh;
|
|
}
|
|
|
|
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;
|
|
}
|
|
|