#!/usr/bin/env perl # The master copy of this script is in Adam's CVS repository; if you make # changes, please mail him a copy, else they'll get overwritten next time he # installs it. use strict; use CGI qw/:standard/; use DB_File; my $internal = 0; $internal = 1 if $ENV{"REMOTE_ADDR"} =~ /^(192\.168\.58\.|81\.91\.98\.|129\.12\.58\.)/; my @sainsburys; open IN, ") { chomp; /^#/ and next; /^([^\t]*)\t([^\t]*)\t(.*)$/ or next; push @sainsburys, [$1, $2, $3]; } close IN; my %items; my %score_memo; my %price; my %what; sub score_item { my ($arg) = @_; return $score_memo{$arg} if (defined $score_memo{$arg}); my $thing = $items{$arg}; $thing =~ s/ for .*$//; foreach my $row (@sainsburys) { my ($aisle, $price, $re) = @$row; if ($thing =~ /$re/i) { $score_memo{$arg} = $aisle; $price{$arg} = $price if $price ne ""; $what{$arg} = $re; return $aisle; } } $score_memo{$arg} = "99"; return "99"; } my $mode = O_CREAT | O_RDONLY; $mode = O_CREAT | O_RDWR if (param("add") or param("del")); tie %items, "DB_File", "shopping-list.db", $mode or die "broken"; if ($internal) { if (param("add")) { $items{param("id")} = param("add"); } foreach my $i (keys %items) { delete $items{$i} if (param("del$i")); } } my $id = time() . "." . $$; print < 5g shopping list

5g shopping list

EOF sub mysort { my $c = (score_item($a) cmp score_item($b)); return $c if $c != 0; return ($a cmp $b); } sub fmtprice { return sprintf("£%.2f", $_[0] / 100.0); } my $i; my $cost = 0; for $i (sort mysort (keys %items)) { my $tmp = $items{$i}; # I will kill you with just my text editor, Mister Charlton. # $tmp =~ s/([a-zA-Z0-9])/\/g; # $tmp =~ s/\.^png/\/g; # $tmp =~ s/\&/\/g; # $tmp =~ s/\(/\/g; # $tmp =~ s/\)/\/g; # $tmp =~ s/\-/\/g; print ""; print "\n"; print ""; if (defined($price{$i})) { print ""; $cost += $price{$i}; } # Enable this to see what matched for debugging. if (0) { print ""; } print "\n"; } print <

Approximate cost: at least EOF print fmtprice($cost); print <

Report bugs to azz, or fix 'em yourself. Not displaying items in horrible Gothic text is not a bug.

EOF untie %items;
$tmp" . fmtprice($price{$i}) . "$what{$i}