parse-wormedit: support older wormedit versions

Detect earlier version 95, 94, and 93 headers (or by --version
override), and parse data accordingly (each former format is mostly
a subset; hide output if it's not present yet).

For version 95 there was also an intermediate file in history, which
has been rewritten to specify (sub)version 94 in order to be able to
detect it automatically.

Uses Perl v5.10 features for slightly nicer code (wasn't necessary,
but compatibility is unlikely to be an issue (who else is gonna run
this code anyway?)).

diff --git a/parse-wormedit b/parse-wormedit
index 2eb9e277e417596d6d9a72204e5caba48a2815dd..473f49ef29a9c93200b528c7ff94b4b3674e5dce 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -1,17 +1,24 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
+use 5.010;
 
 use Data::Dumper;
 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 GetOptions(\my %opt,
-       'raw|r',
+       'raw|r',  # full output
+       'version=i',  # force version
 ) or HelpMessage(-exitval => 2);
 
-my $MAGICID = "WormEdit053\000LVL";
+my %MAGICID = (
+       "WormEdit053\000LVL" => 53,
+       "WormEdit\34195\000LVL" => 95,
+       "WormEdit\34194\000LVL" => 94,
+       "WormEdit\34193\000LVL" => 93,
+);
 
 my @FORMAT = (
        magic       => 'a15',
@@ -98,11 +105,43 @@ sub objsummary {
 
 # read and parse all input data
 local $/;
-my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', readline;
-$rawdata[0] eq $MAGICID
-       or die "File does not match WormEdit level header\n";
-$rawdata[1] == 53
-       or warn "Unsupported version $rawdata[1] (expecting 53)\n";
+my $rawdata = readline;
+my ($id, $subid) = (substr($rawdata, 0, 15), ord substr($rawdata, 15, 1));
+my $version = $opt{version} // $MAGICID{$id}
+       or die "File does not match any known WormEdit level header\n";
+$subid == $version
+       or warn "Unsupported version $subid (expecting $version)\n";
+given ($version) {
+       when (53) {
+               # current @FORMAT
+       }
+       when ($_ <= 95 and $_ > 90) {
+               ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
+               $FORMAT[-1]->[-1]->[0] = '32C'; # less objects
+               continue;
+       }
+       when (95) {
+               $FORMAT[7] = 'Ca64'; # no reserved space after description
+               #ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # only 9 moderefs
+               $FORMAT[19] = 'Ca255'; # enddata
+               splice @FORMAT, 6, 2 if $subid < 95;  # early (sub)version without description
+       }
+       when ($_ <= 94 and $_ > 90) {
+               splice @FORMAT, 6, 2;  # no description
+               splice @{ $FORMAT[7] }, 4, 2;  # no race
+               splice @FORMAT, 16, 2; # no enddata
+               splice @{ $FORMAT[-1] }, 1, 2; # no name
+               continue if $_ < 94;
+       }
+       when (93) {
+               splice @FORMAT, 16, 2; # no hiname
+               $FORMAT[-1]->[0] = 64; # constant amount of levels
+       }
+       default {
+               die "Cannot parse data for Wormedit $version\n";
+       }
+}
+my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $rawdata;
 
 # convert to an easily accessible hash
 my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata);
@@ -115,18 +154,20 @@ if ($opt{raw}) {
        print $output->encode($data), "\n";
 }
 else {
-       print "$data->{name} ($data->{description})\n";
+       print $data->{name};
+       print " ($data->{description})" if defined $data->{description};
+       print "\n";
        printf "File version: %s\n", "WormEdit v$data->{version}";
        printf "Defaults: %s\n", join('; ',
                'sprite ' . scalar @{ $data->{sprite} },
-               'hiscore by ' . $data->{hiname},
+               defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
        );
 
        my $startnr = 0;
        for my $variant (qw/single multi race ctf/) {
-               print "\n";
                my $count = $data->{levelcount}->{$variant};
-               printf "\u$variant ($count)";
+               print "\n";
+               printf '%s (%s)', ucfirst $variant, $count // 'invalid';
                $count or next;
                print ":";
                printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
@@ -149,9 +190,9 @@ else {
        }
        continue {
                print "\n";
-               printf("-- %-21s%4d: %s (%s)\n",
+               printf("-- %-21s%4s: %s (%s)\n",
                        '(ending)',
-                       length $data->{enddata},
+                       defined $data->{enddata} ? length $data->{enddata} : '?',
                        $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr},
                ) if $variant eq 'single';
        }