53 lines
1.4 KiB
Perl
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;
|
|
}
|
|
|