#!/usr/bin/perl -w

# Usages:
#   ./farnell-find [<options>] [describe] NNN-NNNN ....
#       Prints info about the specified relevant part.
#   ./farnell-find [<options>] order [<sid>|<url>] [NNN-NNNN <qty> ...]
#       Add specified parts and quantities to the cart.
#       If no parts and quantities specified on command line,
#        will read from stdin (format is <item> <qty>).
#       If no <sid> or <url> specified (ie thing with jsessionid)
#        then will prompt and read a line from tty.
#   ./farnell-find [<options>] bom <file> ...
#       Processes input files and produces BOM parts list.
#   ./farnell-find [<options>] order-bom <file> ...
#       Processes input files and adds BOM parts to cart.
#
# Options:
#   -S<sort>
#       Specifies sort order for BOM.  Several may be specified, first
#       one on the command line is least significant.  Can be `desc'
#       `avail' `price'.  Default sort order is avail, then price,
#       then desc (equivalent to -Sdesc -Sprice -Savail).
#
# Input format: lines, #-comments, blank lines ignored.
# Indent level is relevant, but only 0, 1, >1 relevant.
# Order of information in a file is not relevant unless explicitly
# stated below.
#
#   <Circuit Name>
#        Starts a circuit.
#        Circuit names must start with an uppercase letter.
#    per <Iteratable>
#        Starts an iteratable (ends at start of next cct).
#        Iteratable name must start with uppercase letter,
#        may contain any non-ws chars.
#     <item> <qty> [<use>]
#     <part> <qty> [<use>]
#        Specifies that the circuit contains that part
#        in the quantity specified.  Quantity is scaled
#        by the iteratable's count if we're in an iteratable.
#        <use> is any string starting with a non-ws char.
#        <qty> is <num>[=] or <num>/<denom>[=].  <num> is
#        an integer.  = says not to order one extra.  <denom>
#        is an integer (meaning the number of gates to
#        a device) or an integer followed by / (meaning we
#        can't mix this use with other uses or other circuits).
#   <part> = <item> [<desc]>
#        Defines <part>.  <part> is a sequence of words each separated
#        by one space.  Each word consists of some non-ws chars.  The
#        first word may not consist entirely of digits and hyphens; no
#        other words may consist entirely of digits, slashes and
#        equals signs.  <desc> is any string starting with non-ws.
#   <part prefix> ? = <desc prefix>
#        Gives a default description of parts which have <part prefix>
#        as an initial subsequence of words.  <part prefix> has the
#        syntax of a <part>.  The description is used only if there is
#        no more specific description, and the constructed description
#        is <desc prefix> with a space and the remainder of the part
#        name appended.
#
#   suppress <item>
#   suppress <part glob>
#        Suppresses all processing for all parts matching the
#        glob.
#
#   count <count> <iteratable>
#   include <circuit>        ) use only one of
#   exclude <circuit>        )  include and exclude
#
#   end
#        Ends the file.  Optional.

use strict;
use POSIX;
use IO::Handle;
use IO::File;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Request::Common;
use HTTP::Response;
use HTML::Entities;

our(@warn);
our(@fault);
# neither @warn nor @fault entries have trailing \n

our(%pkinddesc);
# $pkinddesc{'a b c'} => 'y'  after `a b c ? = y'

our(%parts);
# $parts{"$circuit\n$iteratable"}[]{Part}       or item
# $parts{"$circuit\n$iteratable"}[]{Qty}
# $parts{"$circuit\n$iteratable"}[]{Use}
# $parts{"$circuit\n$iteratable"}[]{FileLine}

our(%partdef);
# $partdef{"part name"}= $item;

our(%count);
# $count{"$iteratable"} is number of times iteratable is instantiated
#   (no syntax for specifying this atm)

our(%iteminstances);
# @{ $iteminstances{$item} }  one entry for every line which mentions it
# $iteminstances{$item}[]{Use}   includes circuit
# $iteminstances{$item}[]{Qty}
# $iteminstances{$item}[]{Mult}   number of this iteratable
# $iteminstances{$item}[]{FileLine}

our(%itemdesc);
# $itemdesc{$item}[]= $desc;

our(%iteminfo);
# $iteminfo{$item}= by_item(...);

our(%show);
# $show{$item}{Head}      ) newline terminated
# $show{$item}{Info}      )  strings ready to print
# $show{$item}{Price}     calculated value

our(%suppress_item);
our(@suppress_partre);

our($incexc); # 'include' or 'exclude'
our(%incexc); # $incexc{$circuit}= 1;   for those mentioned

our(@sorthow);
# list of desc price avail

our($useragent);
our($jsessionid);

our($partfrac_unique)= 'aaaa'; # increments

our($partword1_re)= '\S*[^ \t0-9-]\S*';
our($partword_re)= '\S*[^ \t0-9/=]\S*';
our($part_re)= "$partword1_re(?: $partword_re)*";
our($item_re)= '\d{3}\-\d{3,7}';

our(%stockmap)= ('In Stock' => 'Y',
		 'Awaiting Delivery' => 'A');
our($urlbase)= 'http://uk.farnell.com';

sub get_useragent () {
    my ($whoami,$mailname);
    return if defined $useragent;
    die "want http_proxy\n" unless exists $ENV{'http_proxy'};
    chomp($whoami= `whoami`); $? and die $?;
    chomp($mailname= `cat /etc/mailname`); $? and die $?;
    $useragent= new LWP::UserAgent(env_proxy => 1, keep_alive =>1);
}

sub check_response ($$) {
    my ($response,$url) = @_;
    $response->is_success or die "$url ".$response->as_string." ?";
}

sub by_item ($;$) {
    my ($itemcode,$why) = @_;
    # looks up $itemcode (ddd-d...) at Farnell and returns
    # cat hash ref
    local ($_);
    my ($chr,$shortcode,$sc2,$url,$price);
    $url= "$urlbase/jsp/catalog/viewproductdetails.jsp?prodId=";
    $itemcode =~ m/^(\d\d\d)\-(\d{3,7})$/ or die "$itemcode ?";
    $chr->{Item}= $itemcode;
    $chr->{Shortcode}= $1.$2;
    $url .= $chr->{Shortcode};
    if (!-f "farn.$itemcode") {
	my ($response);
	get_useragent();
	$response= $useragent->get($url);
	check_response($response, $url);
	$_= $response->content;
	open N, ">tmp.farn.$itemcode" or die $!;
	print N or die $!;
	close N or die $!;
	rename "tmp.farn.$itemcode", "farn.$itemcode" or die $!;
	unlink "tmp.farnerr.$itemcode";
    } else {
	$_= `cat farn.$itemcode`; $? and die $?;
    }
    s/[^\n\t\x20-\x7e\£]/\?/g;
    if (!eval {
	$sc2= snarf('Order Code / Sku');
	die "wrong results $sc2 ?\n" unless $sc2 eq $chr->{Shortcode};
	1;
    }) {
	my ($emsg);
	$@ =~ s/\n$//;
	$emsg= "item $itemcode: $@";
	$emsg.= " ($why)" if defined $why;
	push @warn, $emsg;
	return undef;
    }
    $chr->{Description}= snarf('Description');
    eval {
	my ($partno)= snarf('Manufacturer Part Number');
	$chr->{Description}= "[$partno] $chr->{Description}";
    };
    $chr->{Avail}= snarf('Stock Availability');
    $chr->{MinOrder}= snarf('Minimum Order');
    $chr->{Multiple}= snarf('Order Multiple');
    $price= snarf('Unit Price', "\n\<!--.*--\\>");
    $price =~ m/\£(\d+\.\d\d+)$/ or die "price $price ?";
    $chr->{Price}= $1;
    # price
    return $chr;
}

sub snarf ($;$) {
    my ($thing, $allowbefore) = @_;
    $allowbefore= defined $allowbefore ? "(?:$allowbefore)?" : '';
    m!
\<td class="tabledata"(?: width="\d+%")?\>$thing</td>
\<td class="tabledata"(?: width="\d+%")?\>$allowbefore
(.+)(?:\n\&nbsp\;)*
\</td>
!
    or die "no $thing ?\n";
    return $1;
}

sub cart_add (@) {
    my (@orderlist) = @_;
    my ($i, $url, $item, $qty, @submit, $request, $response);
    my ($page_output);
    local ($_);
    need_jsessionid();
    $url= "$urlbase/jsp/op/shoppingbasket.jsp;jsessionid=$jsessionid";
    get_useragent();
    $response= $useragent->get($url);
    check_response($response, $url);
    $_= $response->content;
    if (!eval {
	while (@orderlist) {
	    ($item, $qty, @orderlist) = @orderlist;
	    m!(
?)(\<tr class=\"tabledata)((?:_alt)?)(\"\>
?\<td\>
?\<input type=\"text\" name=\"k1\" value=\")(\"[^<>]*\>
?\<input type=\"hidden\" name=\"_D:k1\" value=\" \"\>
?\</td\>
?\<td\>\<input type=\"text\" name=\"k3\" value=\")1(\"[^<>]*\>
?\<input type=\"hidden\" name=\"_D:k3\" value=\" \"\>
?\</td\>\<td\b[^<>]*\>\&nbsp\;\</td\>
?\</tr\>
?)((?:\<tr class=\"tabledata(?:_alt)?\"\>
?\<td\>
?\<input type=\"text\" name=\"k1\" value=\"\"[^<>]*\>
?\<input type=\"hidden\" name=\"_D:k1\" value=\" \"\>
?\</td\>
?\<td\>\<input type=\"text\" name=\"k3\" value=\"1\"[^<>]*\>
?\<input type=\"hidden\" name=\"_D:k3\" value=\" \"\>
?\</td\>\<td\b[^<>]*\>\&nbsp\;\</td\>
?\</tr\>
?)*\<tr\>
?\<td [^<>]* class=\"tableheading\"\>
?\<\!--td inset--\>
?\<table [^<>]*\>
?\<tr\>
?\<td align=\"right\" class=\"tabletotal\"\>
?Sub Total
?)!
                or die "no blanks\n";

	    my ($page_head)= $`.$1;
	    my ($entry_2alt, $entry_alt2item, $entry_item2qty, $entry_qty2)
		= ($2,$4,$5,$6);
	    my ($this_alt)= !!length $3;
	    my ($page_tail)= $7.$';

	    $_= $page_head.
                $entry_2alt. ($this_alt ? '' : '_alt').
		$entry_alt2item. $item. $entry_item2qty. $qty. $entry_qty2.
		($this_alt ?
		 $entry_2alt.
		 $entry_alt2item. $entry_item2qty. 1 . $entry_qty2.
		 $entry_2alt.'_alt'.
		 $entry_alt2item. $entry_item2qty. 1 . $entry_qty2
		 : '').
		$page_tail;
	}

	m!\</head\>! or die "no </head>\n";
        $page_output= $`. "<base href=\"$urlbase\">\n" . $& . $';
        1;
    }) {
	die "$_ huh $@ ?" unless m/\<body [^<>]*\>/;
        $page_output= $`.$&.
            "<h1><strong>ERRORS FROM FARNELL-FIND:</strong></h1>\n".
            "<p><strong>".
            encode_entities($@).
            "</strong>\n".
            "<h1>In output data:</h1>\n".
            $';
    }
    open N, ">tmp.farn.basket.html" or die $!;
    print N $page_output or die $!;
    close N or die $!;
    exec 'w3m','./tmp.farn.basket.html'; die $!;
}

sub read_spec ($) {
    my ($filename) = @_;
    local ($_);
    my ($circuit,$iteratable,$desc);
    my ($part,$qty,$use,$f);
    $f= new IO::File $filename, 'r' or die "$filename: $!\n";
    for (;;) {
	$_=<$f>;
	die "$filename: read: $!\n" if $f->error;
	last unless defined $_;
	chomp; s/\s+$//;
	last if m/^end$/;
	next if m/^\#/ || !m/\S/;
	if (m/^[A-Z].*$/) {
	    $circuit= $&;
	    $iteratable= '';
	} elsif (m/^ per ([A-Z]\S+)$/) {
	    $iteratable= $1;
	} elsif (m/^ \S/) {
	    die "$_ ?";
	} elsif (m,^\s+($part_re|$item_re)\s+([0-9/=]+)(?:\s+(\S.*))?$,) {
	    ($part,$qty,$use) = ($1,$2,$3);
	    $qty .= $partfrac_unique++ if $qty =~ m,/$,;
	    push @{ $parts{"$circuit\n$iteratable"} }, {
		Part => $part, Qty => $qty, Use => $use,
		FileLine => "$filename:$."
	    };
	} elsif (m/^($part_re)\s+\?\s+\=\s+(\S.*)$/) {
	    die if exists $pkinddesc{$1};
	    $pkinddesc{$1}= $2;
	} elsif (m/^($part_re)\s+\=\s+($item_re)(?:\s+(\S.*))?$/) {
	    die if exists $partdef{$1};
	    $partdef{$1}= $2;
	    if (defined $3) {
		push @{ $itemdesc{$2} }, "$1: $3";
	    }
	} elsif (m/^suppress\s+($item_re)$/) {
	    $suppress_item{$1}= 1;
	} elsif (m/^suppress\s+(\S.*)$/) {
	    $_= $1; s/\s+/ /g;
	    s/\W/ ($& eq '*' ? '.*' :
		   $& eq '?' ? '.' :
		   "\\$&") /ge;
	    push @suppress_partre, $_;
	} elsif (m/^count\s+(\d+)\s+([A-Z].*)$/) {
	    $count{$2}= $1;
	} elsif (m/^(include|exclude)\s+([A-Z].*)$/) {
	    die "both include and exclude\n" if
		defined $incexc && $incexc ne $1;
	    $incexc= $1;
	    $incexc{$2}= 1;
	} else {
	    die "$_ ?";
	}
    }
    $f->close;
}

sub itemsortmap ($) {
    my ($item) = @_;
    my ($o, $bi, $how, $price,$title);
    $o= '';
    $bi= $iteminfo{$item};
    if (!defined $bi) {
	$bi= { Avail => '?U' };
	$bi->{Description} = $itemdesc{$item} ? $itemdesc{$item}[0] : '?U';
    }
    foreach $how (@sorthow) {
	if ($how eq 'price') {
	    $price= exists $show{$item} ? $show{$item}{Price} : 0.0;
	    $o .= sprintf "%030.20f ", 1.0 / ($price + 0.0001);
	} elsif ($how eq 'desc') {
	    $title= $bi->{Description};
	    $title .= "\n".$1 if $title =~ s/^(\[[^][]+\]) //;
	    $o .= "$title\n";
	} elsif ($how eq 'avail') {
	    $o .= $bi->{Avail};
	} else {
	    die;
	}
    }
    return $o;
}

sub hrule () { print '-'x79, "\n" or die $!; }

sub iteminstanceprint ($) {
    my ($ii) = @_;
    my ($ql,$qr);

    $ql= $ii->{Qty}; $qr= '';
    if ($ql =~ s/\D\d+$//) { $qr= $&; }
    if ($ql =~ s,(\d+)/[a-z]+$,,) { $qr= "$1/"; }
    if ($ql =~ s/\=//) { $qr .= $&; }
    return sprintf("%*s %5s%-2s %s%s\n",
		   (4+1+4),'',
		   $ql,$qr,
		   $ii->{Mult} != 1 ? "(x$ii->{Mult}) " : '',
		   $ii->{Use});
}    

sub analyse_spec ($) {
    my ($op) = @_;
    my ($part,$pd,$try,@rhs,$sp,$circuit,$iteratable,$count,$pe,$use);
    my ($item,$totalqty,$ii,$bi,$toorder,$price,$total,$notechar,$desc);
    my ($avail,%avail,$desclen,$why,$suppress,%suppress,$pi);
    my ($iteminstance,@orderlist);
    $desclen= 42;
    foreach $part (sort keys %partdef) {
	$item= $partdef{$part};
	next if exists $itemdesc{$item};

	$try= $part;
	@rhs= ();
	for (;;) {
	    if ($try !~ s/\s+(\S+)$//) {
		push @{ $itemdesc{$item} }, $part;
		last;
	    }
	    unshift @rhs, $1;
	    if (exists $pkinddesc{$try}) {
		push @{ $itemdesc{$item} }, join(' ', $pkinddesc{$try}, @rhs);
		last;
	    }
	}
    }
    foreach $sp (sort keys %parts) {
	$sp =~ m/\n/ or die "$sp ?";
	$circuit= $`;
	$iteratable= $';
	next if
	    (defined $incexc && $incexc eq 'include')
		xor exists $incexc{$circuit};
	if (exists $count{$iteratable}) {
	    $count= $count{$iteratable};
	} else {
	    push @warn, "assuming only 1 $iteratable" if length $iteratable;
	    $count= 1;
	}
	foreach $pe (@{ $parts{$sp} }) {
	    $use= $pe->{Use};
	    $use= defined $use ? "$circuit: $use" : $circuit;
	    $part= $pe->{Part};
	    $suppress= 0;
	    if ($part =~ m/^$item_re$/) {
		$item= $part;
	    } elsif (exists $partdef{$part}) {
		$suppress= 1 if grep { $part =~ m/^$_$/ } @suppress_partre;
		$item= $partdef{$part};
	    } else {
		push @fault, "unknown part $part ($pe->{FileLine})";
		next;
	    }
	    $suppress= 1 if exists $suppress_item{$item};
	    $iteminstance= {
		Use => $use,
		Qty => $pe->{Qty},
		Mult => $count,
		FileLine => $pe->{FileLine},
	    };
	    if ($suppress) {
		push @{ $suppress{$item} }, iteminstanceprint($iteminstance);
	    } else {
		push @{ $iteminstances{$item} }, $iteminstance;
	    }
	}
    }
    $total= 0;
    foreach $item (sort keys %iteminstances) {
	$why= defined $itemdesc{$item} ? $itemdesc{$item}[0].'; ' : '';
	$why .= join ",", map { $_->{FileLine} } @{ $iteminstances{$item} };
	$bi= by_item($item, $why);
	$iteminfo{$item}= $bi;
    }	
    foreach $item (keys %iteminstances) {
	$totalqty= { };
	foreach $ii (@{ $iteminstances{$item} }) {
	    addqty($totalqty, $ii->{Qty}, $ii->{Mult}, $item, $ii->{FileLine});
	}
	$bi= $iteminfo{$item};
	next unless $bi;
	($toorder,$notechar)= calcorder($totalqty, $bi);
	next unless $toorder > 0;
	$price= $toorder * $bi->{Price};
	$avail= $bi->{Avail};
	$avail{$avail}= 1;
	$avail= ' '.$stockmap{$avail} if exists $stockmap{$avail};
	$show{$item}{Head}=
	    sprintf("%4d%1s %-10s %-${desclen}.${desclen}s".
		    " %7.3f %7.2f%1s %s\n",
		    $toorder, $notechar, $item, $bi->{Description},
		    $bi->{Price}, $price, $notechar, $avail);
	$show{$item}{Info}= '';
	$total += $price;
	$show{$item}{Price}= $price;
	$show{$item}{ToOrder}= $toorder;
	foreach $desc (@{ $itemdesc{$item} }) {
	    $show{$item}{Info} .=
		sprintf("%*s %s\n",
			(4+1+1+10),'',
			$desc);
	}
	foreach $ii (@{ $iteminstances{$item} }) {
	    $show{$item}{Info} .= iteminstanceprint($ii);
	}
    }
    if ($op eq 'order-bom') {
	dump_warnerrs();
    } else {
	printf " Qty  %-10s %-*s (ex VAT) Each Total Stock?\n\n",
	    'Item', $desclen-7, 'Part no. and Description'
		or die $!;
    }
    foreach $item (sort { itemsortmap($a) cmp itemsortmap($b); }
		   keys %show) {
	if ($op eq 'order-bom') {
	    push @orderlist, $item, $show{$item}{ToOrder};
	} else {
	    print $show{$item}{Head}, $show{$item}{Info}, "\n"
		or die $!;
	}
    }
    if ($op eq 'order-bom') {
	cart_add(@orderlist);
	die;
    }
    printf("%*s %11s %-*s %6.2f\n",
	   (5+1), 'TOTAL',
	   '',
	   ($desclen+1+6), join(' / ', sort keys %avail),
	   $total)
	or die $!;
    print "\n" or die $!;
    if (keys %suppress) {
	print "---------- suppressed ----------\n" or die $!;
	foreach $item (sort { itemsortmap($a) cmp itemsortmap($b); }
		       keys %suppress) {
	    $pi= $item;
	    foreach $ii (@{ $itemdesc{$item} }) {
		printf " %-10s %s\n", $pi, $ii
		    or die $!;
		$pi= '';
	    }
	    if (length $pi) {
		print " $pi\n" or die $!;
	    }
	    foreach $ii (@{ $suppress{$item} }) {
		print $ii or die $!;
	    }
	}
	print "\n" or die $!;
    }
    dump_warnerrs();
    hrule();
}

sub addqty ($$$$) {
    my ($totalqty, $q2, $m2, $item) = @_;
    if ($q2 !~ m!^(\d+)(?:/(\d+)(?:/(\w+))?)?(\=?)$!) {
	push @fault, "bad quantity $q2 x$m2 for item $item";
	return;
    }
    my ($numer,$denom,$uniq,$exact) = ($1,$2,$3,$4);
    if (!$exact) {
	$totalqty->{Inexact}= 1;
    }
    $denom=1 if !defined $denom;
    $numer *= $m2;
    if (defined $uniq) {
	die if exists $totalqty->{Uniques}{$uniq};
	$totalqty->{Uniques}{$uniq}{Numer}= $numer;
	$totalqty->{Uniques}{$uniq}{Denom}= $denom;
    } else {
	if (!exists $totalqty->{Denom}) {
	    $totalqty->{Denom}= $denom;
	    $totalqty->{Numer}= $numer;
	} elsif ($denom ne $totalqty->{Denom}) {
	    push @fault, "denominator for item $item changes from".
		" $totalqty->{Denom} to $denom";
	} else {
	    $totalqty->{Numer} += $numer;
	}
    }
}

sub calcorder ($$) {
    my ($totalqty, $bi) = @_; # => ($toorder, $notechar);
    my ($notechar, $exact, $need, $uniq);
    $notechar= '';
    $exact= 0;
    if (!exists $totalqty->{Inexact}) {
	$exact= 1;
	$notechar= '=';
    }
    $need= 0;
    foreach $uniq (keys %{ $totalqty->{Uniques} }) {
	$need += calcneed($totalqty->{Uniques}{$uniq}, undef);
    }
    $need += calcneed($totalqty, \$notechar) if exists $totalqty->{Numer};
    $need++ if $need && !$exact;
    if ($need % $bi->{Multiple}) {
	$need= floor(($need + $bi->{Multiple} - 1) / $bi->{Multiple})
	    * $bi->{Multiple};
	$notechar= '*';
    }
    if ($need && $need < $bi->{MinOrder}) {
	$need= $bi->{MinOrder};
	$notechar= '>';
    }
    ($need, $notechar);
}

sub calcneed($$) {
    my ($tqr, $notechar) = @_;
    my ($want, $must);
    $want= $tqr->{Numer} * 1.0 / $tqr->{Denom};
    $must= ceil($want);
    $$notechar= '/' if $must>$want && $notechar;
    return $must;
}   

sub dump_warnerrs () {
    my ($w);
    my (%r);
    foreach $w (@fault) { next if $r{$w}++; print("ERROR: $w\n") or die $!; }
    foreach $w (@warn) { next if $r{$w}++; print("WARNING: $w\n") or die $!; }
    STDOUT->flush or die $!;
    die "errors\n" if @fault;
}

@sorthow= qw(avail price desc);

while (@ARGV && $ARGV[0] =~ m/^\-/) {
    $_= shift @ARGV;
    last if m/^\-\-$/;
    if (m/^\-S(avail|price|desc)$/) {
	unshift @sorthow, $1;
    } else {
	die "unknown option \`$_'\n";
    }
}

sub is_jsessionid ($) {
    my ($a) = @_;
    return undef unless
	$a =~ m/\;jsessionid=([0-9A-Z]+)\b/ ||
	$a =~ m/^([0-9A-Z]+)$/;
    return $1;
}

sub need_jsessionid () {
    local ($_);
    my ($newjsid);
    return if defined $jsessionid;
    open TTY, "+< /dev/tty" or die $!;
    select((select(TTY), $|=1)[0]);
    print TTY "URL or jsessionid: " or die $!;
    $_= <TTY>; TTY->error and die $!;
    length or die;
    $newjsid= is_jsessionid($_);
    defined $newjsid or die;
    $jsessionid= $newjsid;
}

sub main () {
    my ($op);
    my ($item, $a);
    
    die unless @ARGV;
    $op= $ARGV[0] =~ m/^\d/ ? 'describe' : shift @ARGV;

    if ($op eq 'describe') {
	my ($chr, $k);
	foreach $item (@ARGV) {
	    $chr= by_item($item);
	    dump_warnerrs();
	    foreach $k (sort keys %$chr) {
		printf "%-20s %s\n", $k, $chr->{$k} or die $!;
	    }
	}
    } elsif ($op eq 'order') {
	my ($qty, @orderlist, $newjsid);
	while (@ARGV) {
	    $a= shift @ARGV;
	    if (defined($newjsid= is_jsessionid($a))) {
		die if defined $jsessionid;
		$jsessionid= $newjsid;
	    } elsif ($a =~ m/^$item_re$/) {
		die unless @ARGV;
		$qty= shift @ARGV;
		push @orderlist, $a, $qty;
	    } else {
		die "$a ?";
	    }
	}
	if (!@orderlist) {
	    for (;;) {
		defined($_= <STDIN>) or last;
		chomp;
		s/^\s+//; s/\s+$//;
		next if m/^\#/;
		m/^($item_re)\s+(\d+)$/ or die "$_ ?";
		push @orderlist, $1, $2;
	    }
	    die $! if STDIN->error;
	}
	cart_add(@orderlist);
    } elsif ($op eq 'bom' || $op eq 'order-bom') {
	my ($filename);
	foreach $filename (@ARGV) {
	    read_spec($filename);
	}
	analyse_spec($op);
	exit !!@fault;
    } else {
	die;
    }
}

main();