#!/usr/bin/perl -w
#
#  UTILx.DAT parser. Written from documentation, not PHost source.
#
#  Usage: perl parseutil.pl [-d|-u|--help] [-M] [-fNN] utilx.dat [filename.txt]
#         perl parseutil.pl [-d|-u|--help] [-M] [-fNN] -m utilx.dat...
#
#  2001,2002,2003,2004,2005,2006 by Stefan Reuther <Streu@gmx.de>. Public Domain.
#
#  To add a new record type, just add a `decodeNN' function, where
#  NN is the decimal record number. These functions are called with
#  global variable $data = binary image of record. Note that the
#  `decodeNN' functions must return non-zero, which happens implicitly
#  if they end with `print'. Similarily, use `unpackNN' for unpacking
#  files.
#
#  Note 29/Dec/2003: I've changed most decoders to use the
#  `print_unpack' function, for more consistency and reliability. For
#  those which I did not yet test on live data I let the original code
#  in a comment.
#

my $PHOST_VERSION = "4.0i";
my $MAX_RECORD_HANDLED = 57;

@natives = ('none', 'Hum', 'Bov', 'Rep', 'Avi',
	    'Amo', 'Ins', 'Amp', 'Ghi', 'Sil');
@record_names = ('mine_scan',
                 'explosion',
                 'mine_hit',
                 'dark_sense',
                 'super_spy',
                 'explore',
                 'sensor_sweep',
                 'battle',
                 'meteor',
                 'meteorite',
                 'ship_target',      # 10
                 'base_target',
                 'planet_target',
                 'control',
                 'wormhole_scan',
                 'wormhole_travel',
                 'ship_recycled',
                 'ionstorm_scan',
                 'ship_colonized',
                 'ship_surrendered',
                 'ship_built',       # 20
                 'ship_trade',
                 'alliance',
                 'bioscan',
                 'glory_popped',
                 'glory_damage',
                 'ship_boarded',
                 'ftp_config',
                 'ground_attack',
                 'mine_exploding',
                 'end_of_phost',     # 30
                 'mine_scooped',
                 'pillage',
                 'ufo',
                 'ftp_general',
                 'cloak_fail',
                 'anticloak',
                 'remote_list',
                 'pal_report',
                 'build_queue_list',
                 'web_drain_complete', # 40
                 'rga',
                 'ufo_gone',
                 'mine_quota_list',
                 'failure',
                 'planet_trade',
                 'mine_scan_extended',
                 'nonexistant_planet_list',
                 'pal_list',
                 'ship_score',
                 'planet_score',       # 50
                 'player_score',
                 'ship_special_list',
                 'mine_exploding_one',
                 'enemies',
                 'ship_production',
                 'ship_repair',
                 'ship_special_definition'
                 );
my @abilities = ('Alchemy', 'Refinery', 'Advanced Refinery',         # 0..2
                 'Heats to 50', 'Cools to 50', 'Heats to 100',       # 3..5
                 'Hyperdrive', 'Gravitonic', 'Scans all Wormholes',  # 6..8
                 'Gambling', 'Anti-cloak', 'Imperial Assault',       # 9..11
                 'Chunneling', 'Ramscoop', 'Advanced Bioscanner',    # 12..14
                 'Advanced Cloak', 'Cloak', 'Bioscanner',            # 15..17
                 'Glory Device (10%)', 'Glory Device (20%)', 'Unclonable', # 18..20
                 'Clone Once', 'Ungiveable', 'Give Once',            # 21..23
                 'Level 2 Tow', 'Tow', 'Chunnel self',               # 24..26
                 'Chunnel others', 'Chunnel target', 'Planet Immunity', # 27..29
                 'Ore condenser', 'Boarding', 'Anti-cloak Immunity', # 30..32
                 'Academy', 'Repairs', 'Full Weaponry',              # 33..35
                 'Hardened Engines');                                # 36
my @failure_codes = ('bad luck (random chance)',
                     'too little fuel',
                     'excess damage',
                     'ionic pulse',
                     'wormhole travel',
                     'tachyon pulse',
                     'ion storm',
                     '7', '8', '9',
                     'no minerals',
                     'no tech',
                     'no receiver',
                     'feature disabled',
                     'rule violation',
                     'partner denies permission',
                     'global object limit exceeded',
                     'player limit exceeded',
                     'required function not available',
                     'no matching target');

my @filter = ();
my @filenames = ();

my $extractfn = "";
my $action = 'decode';
my $multifn = 0;
my $show_missing = 0;
my $show_offsets = 0;
my $has_playernumbers = 0;
my $playerfilter = 0;
my $help = "\nTry `$0 --help' for help.\n";
while($#ARGV >= 0) {
    my $opt = shift @ARGV;
    if($opt eq '-d' || $opt eq '--decode') {
	$action = 'decode';
    } elsif($opt eq '-u' || $opt eq '--unpack') {
	$action = 'unpack';
    } elsif($opt eq '-m' || $opt eq '--multi') {
        $multifn = 1;
    } elsif($opt eq '-M' || $opt eq '--missing') {
        $show_missing = 1;
    } elsif($opt eq '-O' || $opt eq '--show-offsets') {
        $show_offsets = 1;
    } elsif($opt eq '-t' || $opt eq '--tmp') {
        $has_playernumbers = 1;
    } elsif($opt =~ /^-p(\d+)/ || $opt =~ /^--player=(\d+)/) {
        $playerfilter = $1;
        $has_playernumbers = 1;
    } elsif($opt eq '-i' || $opt eq '--info') {
        show_records();
        exit 0;
    } elsif($opt =~ /^-f(.+)/ || $opt =~ /^--filter=(.*)/) {
        foreach (split /,\s*/, $1) {
            if (/^\w+$/) {
                push @filter, parse_name($_);
            } elsif (/^(\w+)(\.\.|-)(\w+)$/) {
                push @filter, parse_name($1) .. parse_name($3);
            } else {
                print STDERR "$0: invalid filter expression `$1'$help";
                exit 1;
            }
        }
    } elsif($opt eq '-h' || $opt eq '--help') {
        help();
	exit 0;
    } elsif($opt =~ /^-/) {
	print STDERR "$0: invalid option: `$opt'$help";
	exit 1;
    } elsif($multifn || @filename == 0) {
	push @filename, $opt;
    } elsif($extractfn eq "") {
	$extractfn = $opt;
    } else {
	print STDERR "$0: too many arguments$help";
	exit 1;
    }
}

if(@filename == 0) {
    print STDERR "$0: missing file name$help";
    exit 1;
}

my $exitcode = 0;
foreach my $filename (@filename) {
    open FILE, "< $filename" or do {
        print STDERR "$filename: $!\n";
        $exitcode = 1;
        next;
    };
    my $print_head = $multifn;
    my $offs = 0;
    my $headersize = $has_playernumbers ? 6 : 4;
    binmode FILE;
    while(read FILE, $header, $headersize) {
        my ($player, $typ, $len);
        if ($has_playernumbers) {
            ($player, $typ, $len) = unpack "vvv", $header;
        } else {
            ($typ, $len) = unpack "vv", $header;
        }
        my $doit = @filter==0 || grep {$_ == $typ} @filter;
        if ($playerfilter && $player != $playerfilter) { $doit = 0 }
        if ($doit && $print_head) {
            print "== $filename:\n";
            $print_head = 0;
        }
        eval "&${action}_pre ($offs, $typ, $len, \$player)"
            if $doit;

        read FILE, $data, $len;

        eval "&$action$typ" || eval "&${action}_default"
            if $doit;

        $offs += 4 + $len;
    }
}
exit $exitcode;

### Decoder ##########################################################

sub decode_default {
    print " (unknown)\n";
}

sub decode_pre {
    my ($offs, $typ, $len, $player) = @_;
    if ($show_offsets) {
        printf "%08X: ", $offs;
    }
    print "Player $player, " if defined($player);
    print "Type $typ, Length $len";
}

sub decode0 {
    print " -- Minefield\n";
    print_unpack ($data,
                  [ "w,Id",
                    "c,At",
                    "w,Owner",
                    "u,Units",
                    "e,Type",
                    "w,FCode Planet",
                    "e,Scan Type" ],
                  [ "Normal", "Web" ],
                  [ "lay", "sweep", "scan" ]);
}

sub decode1 {
    print " -- Explosion\n";
    print_unpack ($data,
                  [ "c,Position",
                    "w,Ship Id",
                    "s20,Ship Name" ]);
}

sub decode2 {
    print " -- Mine Hit\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "c,At",
                    "w,Damage",
                    "s20,Name" ]);
}

sub decode3 {
    print " -- Dark Sense\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Owner",
                    "l,Neutronium",
                    "l,Tritanium",
                    "l,Duranium",
                    "l,Molybdenum",
                    "l,Cash",
                    "b,Starbase" ]);
}

sub decode4 {
    print " -- Super Spy\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Mines",
                    "w,Factories",
                    "w,Defense Posts",
                    "s3,Friendly Code",
                    "l,Neutronium",
                    "l,Tritanium",
                    "l,Duranium",
                    "l,Molybdenum",
                    "l,Cash",
                    "l,Supplies" ]);
}

sub decode5 {
    print " -- Exploration\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "t,Temperature",
                    "w,Owner",
                    "l,Colonists",
                    "b,Starbase" ]);
}

sub decode6 {
    print " -- Industry\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Owner",
                    "e,Industry" ],
                  [ "none", "minimal", "light", "moderate", "substantial",
                    "heavy", "super heavy" ]);
}

sub decode7 {
    # Leave this one as it is; the "print_unpack" format would be
    # worse formatted because it cannot reorder values.
    my ($sid1, $sid2, $planet, $own1, $own2,
	$dam1, $dam2, $t1, $t2, $f1, $f2,
	$out1, $out2, $x, $y, $seed) = unpack "v16", $data;
    my @outlist = ('Won', 'Captured', 'Destroyed', 'Disabled');
    my $pors = $planet ? "Planet" : "Ship";
    unless(defined $seed) { $seed = '?' }
    print " -- Combat
  At:             ($x, $y)
  Left:           Ship \#$sid1, Owner $own1
    Result:       $outlist[$out1]
    Weapons:      $t1 Torps, $f1 Fighters left
  Right:          $pors \#$sid2, Owner $own2
    Result:       $outlist[$out2]
    Weapons:      $t2 Torps, $f2 Fighters left
  Seed:           $seed
";
}

sub decode8 {
    print " -- Meteor\n";
    decode_meteor ();
}

sub decode9 {
    print " -- Meteorite\n";
    decode_meteor();
}

sub decode_meteor {
    print_unpack ($data,
                  [ "w,Planet Id",
                    "l,Neutronium",
                    "l,Tritanium",
                    "l,Duranium",
                    "l,Molybdenum" ]);
}

sub decode10 {
    print " -- Ship Target\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Owner",
                    "w,Speed",
                    "c,At",
                    "w,Hull",
                    "w,Heading",
                    "s20,Name" ]);
}

sub decode11 {
    print " -- Base Target\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Owner" ]);
}

sub decode12 {
    print " -- Planet Target\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Owner",
                    "t,Temperature",
                    "e,Natives",
                    "e,  Native Govm",
                    "l,  Population",
                    "l,Neutronium",
                    "l,Tritanium",
                    "l,Duranium",
                    "l,Molybdenum",
                    "l,Colonists",
                    "l,Supplies",
                    "l,Cash" ],
                  \@natives,
                  [ "none", "anarchy [20%]", "pre-tribal [40%]",
                    "early-tribal [60%]", "tribal [80%]",
                    "feudal [100%]", "monarchy [120%]",
                    "representative [140%]", "participatory [160%]",
                    "unity [180%]" ]);
}

sub decode13 {
    # leave these as is because of host version parsing
    my ($ts, $num, $player, $maj, $min, $hull, $eng, $beam,
	$torp, $truehull, $pxy, $conf, $racename, $game, $relcode)
	= unpack "A18vvccV8A32A", $data;
    $relcode = "" if !defined $relcode;
    print " -- Control
  Game Name:      $game
  Player:         $player
  Turn Number:    $num
    Timestamp:    $ts
  Host Vsn.:      $maj.$min$relcode
";
}

sub decode14 {
    print " -- Wormhole Scan\n";
    print_unpack ($data,
                  [ "c,Position",
                    "w,Mass",
                    "e,Stability",
                    "w,Id",
                    "w,Ufo Id",
                    "b,Bidirectional" ],
                  [ "very stable", "stable", "mostly stable",
                    "unstable", "very unstable", "completely unstable" ]);
}

sub decode15 {
    print " -- Wormhole Travel\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "c,Wormhole At",
                    "w,New Damage",
                    "w,Total Damage",
                    "w,Wormhole Id" ]);
}

sub decode16 {
    print " -- Ship Recycled\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Base Id" ]);
}

sub decode17 {
    print " -- Ion Storm\n";
    print_unpack ($data,
                  [ "w,Id",
                    "c,At",
                    "w,Voltage",
                    "w,Heading",
                    "w,Speed",
                    "w,Radius",
                    "w,Class",
                    "b,Grows" ]);
}

sub decode18 {
    print " -- Ship Colonized\n";
    print_unpack ($data,
                  ["w,Ship Id",
                   "w,Planet Id"]);
}

sub decode19 {
    print " -- Ship Surrendered\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Owned by",
                    "w,Base Id",
                    "w,Base Owner" ]);
}

sub decode20 {
    print " -- Ship Built\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Base Id",
                    "b,Cloned" ]);
}

sub decode21 {
    print " -- Ship Traded\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,From",
                    "w,To" ]);
}

sub decode22 {
    my @allies = unpack "C44", $data;
    print " -- Alliance Status\n";
    foreach (1..11) {
	my ($to, $from, $cto, $cfrom) =
	    ($allies[$_-1],  $allies[$_+10],
	     $allies[$_+21], $allies[$_+32]);
	my $we = &ally_str ($to, $cto);
	my $they = &ally_str ($from, $cfrom);
	next if $we eq "" && $they eq "";
	$we = " " x 15 if $we eq "";

	print "  Player $_:   ", ($_ < 10 ? " " : ""), "our offer: $we   their offer: $they\n";
    }
    1;
}

sub decode23 {
    print " -- Bioscan\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "e,Native Race",
                    "l,  Pop.",
                    "t,Temperature" ],
                  \@natives);
}

sub decode24 {
    print " -- Glory Device Exploded\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "c,At" ]);
}

sub decode25 {
    print " -- Glory Device Exploded\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "c,At",
                    "w,Damage",
                    "w,GD Owner",
                    "w,Ship Hull",
                    "s20,Name" ]);
}

sub decode26 {
    print " -- Ship Boarded\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Owner",
                    "w,Captured By",
                    "w,  Ship Id" ]);
}

sub decode27 {
    $data = "pconfig.src \1" . $data;
    decode34 (@_);
}

sub decode28 {
    print " -- Ground Combat\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,Owner",
                    "w,Attacker",
                    "e,Outcome" ],
                  [ "Owner won", "Attacker won", "Planet unowned" ]);
}

sub decode29 {
    print " -- Mines Exploding\n";
    print_unpack ($data,
                  [ "c,Minefield At",
                    "w,  Id",
                    "c,Minefield At",
                    "w,  Id",
                    "l,Units" ]);
}

sub decode30 {
    print " -- End Of PHost Information\n";
}

sub decode31 {
    print " -- Mines Scooped\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Minefield",
                    "w,Torpedoes",
                    "l,Units scooped",
                    "u,  Size before" ]);
}

sub decode32 {
    print " -- Planet Pillaged\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "l,Colonists",
                    "l,Natives",
                    "w,Klingon Race" ]);
}

sub decode33 {
    print " -- Object\n";
    print_unpack ($data,
                  [ "w,Object Id",
                    "c,At",
                    "w,Color",
                    "w,Radius",
                    "w,Speed",
                    "w,Heading",
                    "s20,Name",
                    "s20,  Info",
                    "s20,  Info",
                    "w,Type" ]);
}

sub decode34 {
    my ($name, $flag) = unpack "A12c", $data;
    my $type = ('binary', 'text')[$flag & 1];
    my $size = (length $data) - 13;
    print " -- File Transfer
  Name:           '$name'
  Type:           $type
  Size:           $size
";
}

sub decode35 {
    print " -- Cloak Failure\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "e,Reason" ],
                  \@failure_codes);
}

sub decode36 {
    print " -- Cloaked Ship Detected\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "c,At",
                    "w,Owner",
                    "e,When" ],
                  [ "before movement", "after movement" ]);
}

sub decode37 {
    print " -- Remote Control Status";
    while($data ne "") {
	my ($sid, $own) = unpack "vv", $data;
	$own = "(forbidden)" if $own == 65535;
	$data = substr $data, 4;
	print "
  Ship Id:        $sid
    Owner:        $own";
    }
    print "\n";
}

sub decode38 {
    print " -- Activity Level\n";
    print_unpack ($data,
                  [ "l,Old Value",
                    "l,Decayed",
                    "l,New Points",
                    "l,New Value" ]);
}

sub decode39 {
    print " -- Build Queue\n";
    while($data ne "") {
        my $entry = substr($data,0,10);
        $data = substr($data,10);
        print_unpack ($entry,
                      [ "w,Base Id",
                        "w,  Hull",
                        "w,  Queue Pos",
                        "l,  Priority" ]);
    }
    1;
}

sub decode40 {
    print " -- Web Drain Complete\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "w,Owner",
                    "s20,Name" ]);
}

sub decode41 {
    print " -- Rebel Ground Attack\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "b,Natives",
                    "w,Rebel Race" ]);
}

sub decode42 {
    print " -- Object Destroyed\n";
    print_unpack ($data, [ "w,Object Id", "w,Type" ]);
}

sub decode43 {
    my @data = unpack "v22", $data;
    print " -- Minefield Quota Report\n";
    print "  Pl   Laid Allowed\n";
    foreach (1..11) {
        my $laid = $data[$_+10];
        if ($laid == 65535) { $laid = "<unk>" };
        printf "  %2d: %5s %5d\n", $_, $laid, $data[$_-1];
    }
    1;
}

sub decode44 {
    my ($act) = unpack "v", $data; # action code, we need it
    print " -- Failed Action\n";
    if ($act == 10000) {
        print_unpack ($data,
                      [ "e,Action",
                        "w,Ship Id",
                        "w,Planet Id",
                        "e,Cause",
                        "w,  Mission",
                        "w,  Intercept",
                        "w,  Tow" ],
                      \@record_names,
                      \@failure_codes);
    } else {
        print_unpack ($data,
                      [ "e,Action",
                        "w,Ship Id",
                        "w,Planet Id",
                        "e,Cause" ],
                      \@record_names,
                      \@failure_codes);
    }
}

sub decode45 {
    print " -- Planet Traded\n";
    print_unpack ($data,
                  [ "w,Planet Id",
                    "w,From",
                    "w,To" ]);
}

sub decode46 {
    decode0 (@_);
}

sub decode47 {
    print " -- Nonexistant Planets\n";
    foreach (unpack "v*", $data) {
        print "  Planet Id:      $_\n";
    }
    1;
}

sub decode48 {
    my @pal = unpack "V11", $data;
    print " -- PAL Summary\n";
    foreach (1..11) {
        $pal[$_-1] -= 2**32 if $pal[$_-1] >= 2**31;
        printf "  Player %2d:      %d\n", $_, $pal[$_-1]
            unless $pal[$_-1] < 0;
    }
    1;
}

sub decode49 {
    print " -- Ship Score\n";
    decode_uscore ($data);
}

sub decode50 {
    print " -- Planet Score\n";
    decode_uscore ($data);
}

sub decode_uscore {
    my ($name, $type, $limit, @data) = unpack "A50vvv*", shift;
    print "  Score Name:     $name
  Score Id:       $type
  Limit:          $limit\n";
    print "  Id   Level\n", "  ---  -----\n";
    while (@data >= 2) {
        my $id = shift @data;
        my $level = shift @data;
        printf "  %3d   %2d\n", $id, $level;
    }
    print "  FILE DAMAGED!\n" if @data;
    1;
}

sub decode51 {
    my ($name, $type, $turnlimit, @scores) = unpack "A50vvV12", $data;
    print " -- Player Score
  Score Name:     $name
  Score Id:       $type
  Victory if:     $scores[0] points for $turnlimit turns\n";
    for (1..11) {
        printf "    Player %2d:    %d\n", $_, $scores[$_]
            unless $scores[$_] == 0xffffffff;
    }
    1;
}

sub decode52 {
    my ($id, @rest) = unpack "v*", $data;
    print " -- Ship Abilities
  Ship Id:     $id\n";
    foreach (@rest) {
        if ($_ >= 0 && $_ < @abilities) { print "  - ", $abilities[$_], "\n" }
        else { print "  - $_\n"; }
    }
    1;
}

sub decode53 {
    print " -- Minefield explodes\n";
    print_unpack ($data,
                  [ "c,Minefield At",
                    "w,  Id",
                    "l,Units lost" ]);
}

sub decode54 {
    print " -- Enemy status\n";
    my $v = unpack "v", $data;
    my $ok = 0;
    foreach (1 .. 11) {
        if ($v & (1 << $_)) {
            print "  player $_\n";
            ++$ok;
        }
    }
    print "  (none)\n"
      unless $ok;
    1;
}

sub decode55 {
    print " -- Production report\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "e,Cargo Type",
                    "e,Produced Using",
                    "w,Amount Produced" ],
                  [ "Fuel", "Tritanium", "Duranium", "Molybdenum",
                    "Colonists", "Supplies", "Money", "Ammo" ],
                  [ "(free items)", "ship cargo", "planet resources", "ship cargo & planet resources" ]);
}

sub decode56 {
    print " -- Repair Report\n";
    print_unpack ($data,
                  [ "w,Ship Id",
                    "e,How",
                    "w,Repaired By",
                    "w,Damage Repaired",
                    "w,Crew Added" ],
                  [ "Supply repair", "Starbase", "Self repair", "Super refit", "Repair ship" ]);
}

sub decode57 {
    print " -- Special Function\n";
    print_unpack ($data,
                  [ "w,Function Id",
                    "e,Basis Function",
                    "i,Exp Levels" ],
                  \@abilities);
}

### Unpacker #########################################################

sub unpack_pre {
}

sub unpack_default {
}

sub unpack27 {
    $data = "pconfig.src \1" . $data;
    &unpack34;
}

sub unpack34 {
    my ($name, $flag) = unpack "A12c", $data;
    my $type = ('binary', 'text')[$flag];
    my $size = (length $data) - 13;
    my $accept = ($extractfn eq "") || (lc $extractfn eq lc $name);
    if($accept) {
	print "Receiving `$name' ($size bytes, $type)\n";
	open OUT, "> $name" or do {
	    print "$name: $!";
	    return 1;
	};
	my $fdata = substr $data, 13;
	if ($flag) {
	    $fdata =~ s/\r//g;
	} else {
	    binmode OUT;
	}
	print OUT $fdata;
	close OUT;
    } else {
	print "Skipping `$name' ($size bytes, $type)\n";
    }
}

### Utilities ########################################################

sub print_unpack {
    # 'pattern' is a list of strings of the form
    # "typ,text". The "typ" can be one of
    #   w      word
    #   b      bool
    #   e      enum [list reference follows]
    #   t      temperature
    #   i      bitfield
    #   l      long
    #   x      long, as hex
    #   u      long, mine unit count
    #   sNN    string of length NN
    #   c      x,y pair
    my $data = shift;
    my @pattern = @{shift(@_)};
    while ($data ne '' && @pattern) {
        shift(@pattern) =~ m{(.*?),(.*)}
          or die "huh?";
        my ($type, $text) = ($1, $2);
        my $value;
        if ($type eq 'w' || $type eq 'b' || $type eq 'e' || $type eq 't' || $type eq 'i') {
            # word-size types
            last if length($data) < 2;
            $value = unpack "v", substr($data,0,2);
            $data = substr($data,2);
            if ($type eq 'b') {
                # bool
                if ($value == 0) { $value = 'no' }
                elsif ($value == 1) { $value = 'yes' }
            } elsif ($type eq 'e') {
                # enum
                my $defn = shift
                  or die "hups?";
                if ($value >= 0 && $value < @$defn) {
                    $value = $defn->[$value] . " ($value)";
                }
            } elsif ($type eq 't') {
                # temp
                my $c = int(($value-32)*5/9);
                $value = "$value F ($c C)";
            } elsif ($type eq 'i') {
                # bitfield
                my @list;
                foreach (0 .. 15) {
                    push @list, $_ if $value & (1 << $_);
                }
                if (@list) { $value = join ' ', @list }
                else { $value = '<none>' };
            } else {
                # number
                $value -= 2**16 if $value >= 2**15;
            }
        } elsif ($type eq 'l' || $type eq 'x' || $type eq 'u') {
            # long-size types
            last if length($data) < 4;
            $value = unpack "V", substr($data,0,4);
            $data = substr($data,4);
            if ($type eq 'x') {
                # hex
                $value = sprintf "0x%08X", $value
            } elsif ($type eq 'u') {
                # mine unit count
                $value = "$value (radius " . int(sqrt($value)) . " ly)";
            } else {
                # number
                $value -= 2**32 if $value >= 2**31;
            }
        } elsif ($type eq 'c') {
            # coordinate pair
            last if length($data) < 4;
            my ($x,$y) = unpack "vv", substr($data,0,4);
            $data = substr($data,4);
            $value = "($x, $y)";
        } elsif ($type =~ /^s(\d+)/) {
            # string
            last if length($data) < $1;
            $value = substr($data,0,$1);
            $data = substr($data,$1);
            $value =~ s/\s+$//;
            $value =~ s/\0.*//;
        } else {
            die "pffffh.";
        }
        printf "  %-15s %s\n", "$text:", $value;
    }
    while (@pattern) {
        shift(@pattern) =~ m{(.*?),(.*)}
          or die;
        printf "  %-15s <missing>\n", "$2:"
          if $show_missing;
    }
    if ($data ne '') {
        my $count = 0;
        print "  Extra data (", length($data), " bytes):";
        foreach (split //, $data) {
            print "\n   " if ($count++ % 16) == 0;
            printf " %02X", ord($_);
        }
        print "\n";
    }
    1;
}

# Fix names. Some utilities (Dominate, qvs) write zero-terminated,
# not space-padded names. Called as `&frobname (\$n1, \$n2, \$n3)'
sub frobname {
    foreach (@_) {
	my $x = index $$_, "\0";
	$$_ = substr $$_, 0, $x if $x >= 0;
    }
}

# Format alliance offer
sub ally_str {
    my ($un, $cond) = @_;
    return "" if ($un & 32) == 0;

    my $res = "";
    foreach (0 .. 4) {
	my $val = 1 << $_;
	$res .= ("s", " p", " m", " c", " v")[$_];
	$res .= ($un & $val ? $cond & $val ? "~" : "+" : "-");
    }
    return $res;
}

sub help {
    print "$0 -- UTILx.DAT parser for PHost version $PHOST_VERSION

Usage: $0 [-options] utilx.dat [filename]
       $0 [-options] -m util1.dat util2.dat...
       $0 -i

Options:
  -h   --help      This friendly help message
  -d   --decode    Decode utilx.dat and print it to stdout,
                   in human-readable form (default)
  -u   --unpack    Unpack embedded files (only FILENAME if specified)
  -fR  --filter=R  Display only record R. Options are cumulative.
                   R can be a comma-separated list of numbers ('12'),
                   ranges ('1-10'), or names.
  -m   --multi     Parse multiple files in one run.
  -M   --missing   Show missing fields (default is to silently drop them).
  -O   --show-offsets  Show record offsets before each record.
  -t   --tmp       UTIL.TMP format (includes player numbers).
  -pN  --player=N  Display only one player (implies '-t').
  -i   --info      List all supported records, don't parse a file

Highest record number handled: $MAX_RECORD_HANDLED

2001,2002,2003,2004,2005,2006 by Stefan Reuther <Streu\@gmx.de>. Public Domain.
";
}

sub show_records {
    print "Records understood by this program:\n";
    foreach (0 .. $#record_names) {
        print "  $record_names[$_] ($_)\n";
    }
}

sub parse_name {
    my $what = lc(shift);
    if ($what !~ /\D/) {
        return $what;
    } else {
        my @canbe;
        for (my $i = 0; $i <= $#record_names; ++$i) {
            if ($what eq $record_names[$i]) {
                return $i;
            } elsif ($record_names[$i] =~ /^\Q$what/) {
                push @canbe, $i;
            }
        }
        if (@canbe == 1) {
            return $canbe[0];
        } if (@canbe == 0) {
            print STDERR "$0: unknown record name `$what'\n";
            exit 1;
        } else {
            print STDERR "$0: ambiguous record name `$what', can be `",
                join("', `", map{$record_names[$_]} @canbe), "'\n";
            exit 1;
        }
    }
}