pctb/yppsc-decode-marketdata

   1 #!/usr/bin/perl
   2
   3 use IO::Handle;
   4
   5 open CM, "commodmap" or die $!;
   6 while (<CM>) {
   7     m/^(\S.*\S)\t(\d+)$/ or die;
   8     $commodmap[$2]= $1;
   9 }
  10 die $! if CM->error;
  11
  12 %stallkinds= qw(A Apothecary
  13                 D Distilling
  14                 F Furnishing
  15                 I Ironworking
  16                 S Shipbuilding
  17                 T Tailor
  18                 W Weaving);
  19
  20 sub getline() {
  21     $!=0; my $l= <STDIN>; die $! unless defined $l;
  22     die $! if STDIN->error;
  23     die unless chomp $l;
  24 #print STDERR "GOT LINE [$l]\n";
  25     return $l;
  26 }
  27
  28 sub getint() {
  29     my $b;
  30     my $r= read STDIN,$b,2; die $! if STDIN->error;
  31     die unless $r==2;
  32     my $v= scalar unpack "v", $b;
  33 #printf STDERR "GOT INT %d 0x%x\n", $v, $v;
  34     return $v;
  35 }
  36
  37 sub inmap($\@$) {
  38     my ($what,$ary,$ix) = @_;
  39     my $got= $ary->[$ix];
  40     return $got if defined $got;
  41     die "$what $ix ?";
  42 }
  43
  44
  45 printf "# Version: \"%s\"\n", getline();
  46 $nstalls= getline()+0;
  47
  48 while (@stalls < $nstalls) {
  49     $_= getline();
  50     if (s/\^[A-Z]$//) {
  51         $kind= $1;
  52         $sk= $stallkinds{$kind};
  53         die "kind $kind in $_ ?" unless defined $sk;
  54         $_ .= "'s $sk Stall";
  55     }
  56     push @stalls, $_;
  57 }
  58 unshift @stalls, undef;
  59
  60 $|=1;
  61
  62 foreach $bs qw(Buy Sell) {
  63     $ncommods= getint();
  64     for ($commodnum=0; $commodnum<$ncommods; $commodnum++) {
  65         $commodix= getint();
  66         $offers= getint();
  67         for ($offernum=0; $offernum<$offers; $offernum++) {
  68             $stallix= getint();
  69             $price= getint();
  70             $qty= getint();
  71             printf("%s\t%s\t%s",
  72                    $bs,
  73                    inmap('commod',@commodmap,$commodix),
  74                    inmap('stall',@stalls,$stallix)) or die $!;
  75             if ($bs eq 'Sell') { print "\t\t" or die $!; }
  76             printf("\t%d\t%d", $price, $qty) or die $!;
  77             if ($bs eq 'Buy') { print "\t\t" or die $!; }
  78             print "\n" or die $!;
  79         }
  80     }
  81 }