#!perl use RevBank::Products qw(read_products); use FindBin qw($Bin); my $fn = ".revbank.oepl"; my $hex = '[0-9A-F]'; my $mac_regex = qr/^(?:$hex {12}|$hex {14}|$hex {16})$/x; sub _create() { open my $fh, '>>', $fn; } sub _run(@args) { local $ENV{REVBANK_SKIP_LOCK} = 1; system perl => "$Bin/contrib/openepaperlink.pl", @args; } sub _read_oepl() { return { map { (split " ")[0, 1] } slurp $fn }; } sub _touch() { utime undef, undef, $fn; } sub command :Tab(openepaperlink) ($self, $cart, $command, @) { if ($command =~ $mac_regex) { my $mac2product = _read_oepl; return REDO, $mac2product->{$command} if exists $mac2product->{$command}; } $command eq 'openepaperlink' or return NEXT; return "Product ID (or 'unlink')", sub ($self, $cart, $product_id, @) { my $product; if ($product_id ne 'unlink') { $product = read_products->{$product_id} or return REJECT, "No such product."; $product_id = $product->{id}; # don't use alias } return "Tag MAC", sub ($self, $cart, $mac, @) { $mac =~ $mac_regex or return REJECT, "Malformed MAC."; _run erase => $mac if $product_id eq 'unlink'; # while it's still in the .oepl _create; my $found = 0; rewrite $fn, sub($line) { my ($m) = split " ", $line; return $line if $m ne $mac; $found++; return undef if $product_id eq 'unlink'; return "$mac $product_id\n" if $m eq $mac; }; if (!$found and $product_id ne 'unlink') { append $fn, "$mac $product_id\n"; } _run $mac unless $product_id eq 'unlink'; return ACCEPT; }; }; } sub hook_products_changed($class, $changes, $mtime, @) { -f $fn or return; return with_lock { $mtime >= (stat $fn)[9] or return; my @macs; my %deleted; my %product2mac = reverse %{ _read_oepl() }; for my $pair (@$changes) { my ($old, $new) = @$pair; my $id = defined($new) ? $new->{id} : $old->{id}; $product2mac{$id} or next; push @macs, $product2mac{$id}; } @macs or return; _run @macs; sleep 1 if $mtime == time; _touch; }; }