ottd_scan.pl

#!/usr/bin/env perl
#
# Copyright (c) 2016, LCD 47 <lcd047@gmail.com>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

use v5.12;
use strict;
use warnings;

use File::Basename;
use Getopt::Std;
use Carp qw(croak);
use Readonly;

use Encode qw(decode);
use Fcntl qw/:DEFAULT :seek/;
use Math::Int64 qw(net_to_int64);
use Number::Format qw(format_number);
use Date::Calc qw(Add_Delta_Days Month_to_Text);
use Template;
use Text::CSV;
use Data::Dumper;


use constant {
    CH_RIFF         => 0,
    CH_ARRAY        => 1,
    CH_SPARSE_ARRAY => 2,
    CH_TYPE_MASK    => 3,
    CH_LAST         => 8,
    CH_AUTO_LENGTH  => 16,
};


Readonly my @COST_NAMES => (
    'construction',
    'new',
    'rc_trains',
    'rc_road',
    'rc_aircrafts',
    'rc_ships',
    'property',
    'inc_trains',
    'inc_road',
    'inc_aircrafts',
    'inc_ships',
    'interest',
    'other',
);


Readonly my @CHEATS => (
    'Magic bulldozer',
    'Switch company',
    'Money',
    'Crossing tunnels',
    'Dummy1',
    'No jetcrash',
    'Dummy2',
    'Change date',
    'Set production',
    'Dummy3',
    'Edit max height',
);


Readonly my @SINGLE_CHUNKS => qw(
    AIPL ANIT APID CAPA CHKP CHTS CITY CMPU DEPT ECMY ENGS ERNW GLOG
    GOAL GRPS GSDT ITBL LGRS MAP7 NAME NGRF OBJS ORDL PATS PLYR PSAC
    RAIL ROAD SIGN STPA SUBS VEHS VIEW
);


Readonly my %HANDLERS => (
    AIPL => \&read_AIPL,
    CHTS => \&read_CHTS,
    DATE => \&read_DATE,
    GSDT => \&read_GSDT,
    NGRF => \&read_NGRF,
    PATS => \&read_PATS,
    PLYR => \&read_PLYR,
);


our $VERSION = '0.1';
my ( $pname, %opt, %game, @company );


sub HELP_MESSAGE {
    print STDERR <<EOT ;
Usage: $pname [-s <chunk>] [-t <template>] [-c <company>] [-o <file>] [-h] [-v] <savegame>
 -s <c> - save chunks of type <c> to files
 -t <t> - use template file <t> to print summary
 -c <c> - print stats for company <c> as CSV
 -o <f> - set filename for -x
 -d	- debug
 -v	- print version and exit
 -h     - print this help and exit
EOT
    exit 1;
}


sub VERSION_MESSAGE {
    my $out = shift;
    print $out qq($pname $VERSION\n);
}


sub usage {
    HELP_MESSAGE \*STDERR;
}


sub fread {
    my ( $fi, $len, $ref_size ) = @_;
    my $buf;

    $len >= 0 && ( sysread $fi, $buf, $len ) == $len
	or croak qq(can't read $len bytes: $!);
    $$ref_size -= $len
	if ( defined $ref_size );
    return $buf;
}


sub fread_uint8 {
    my ( $fi, $ref_size ) = @_;

    return unpack 'C', fread $fi, 1, $ref_size;
}


sub fread_uint32 {
    my ( $fi, $ref_size ) = @_;

    return unpack 'N', fread $fi, 4, $ref_size;
}


sub fread_uint32h {
    my ( $fi, $ref_size ) = @_;

    my ( $val, undef ) = unpack 'nn', fread $fi, 4, $ref_size;
    return $val;
}


sub fread_uint64 {
    my ( $fi, $ref_size ) = @_;

    return net_to_int64 fread $fi, 8, $ref_size;
}


sub fread_str {
    my ( $fi, $ref_size ) = @_;

    my $lng = fread_uint8 $fi, $ref_size;
    return $lng ? decode 'UTF-8', unpack 'a*', fread $fi, $lng, $ref_size : '';
}


sub fskip {
    my ( $fi, $offset, $ref_size ) = @_;

    return if ( !$offset );

    # XXX sysseek() should work for the :unix layer, but it doesn't:
    # sysseek $fi, $offset, SEEK_CUR
	# or die qq(can't seek: $!);
    # $$ref_size -= $offset
	# if ( defined $ref_size );

    # XXX So we do full reads instead:
    fread $fi, $offset, $ref_size;
}


sub fwrite {
    my ( $f, $buf ) = @_;
    my $len = length $buf;

    ( syswrite $f, $buf, $len ) == $len
	or croak qq(can't write $len bytes: $!);
}


sub save_chunk {
    my ( $fi, $len, $id, $seq, $idx ) = @_;

    my $fn = $id;
    $fn .= sprintf '%03d',  $seq if (!grep $id, @SINGLE_CHUNKS);
    $fn .= sprintf '.%03d', $idx if ( defined $idx );

    open my $fo, '>', $fn
	or croak qq(can't open file $fn: $!);
    fwrite $fo, (fread $fi, $len);
    close $fo
	or croak qq(can't close file $fn: $!);
}


sub read_gamma {
    my $fi = shift;
    my $gamma;

    $gamma = fread_uint8 $fi;
    if ( ( $gamma & 0xF0 ) == 0xE0 ) {
	return unpack 'N', chr ( $gamma & 0xF ) . unpack 'a3', fread $fi, 3;
    }
    elsif ( ( $gamma & 0xE0 ) == 0xC0 ) {
	return unpack 'N', "\0" . chr ( $gamma & 0x1F ) . unpack 'a2', fread $fi, 2;
    }
    elsif ( ( $gamma & 0xC0 ) == 0x80 ) {
	return unpack 'n', chr ( $gamma & 0x3F ) . unpack 'a', fread $fi, 1;
    }
    elsif ( ( $gamma & 0x80 ) == 0 ) {
	return $gamma & 0x7F;
    }
    else {
	croak qq(Invalid gamma);
    }
}


sub read_AIPL {
    my ( $fi, $ref_size, $r ) = @_;

    # _ai_saveload_name
    my $name = fread_str $fi, $ref_size;

    if ($name) {
	$$r{name} = $name;

	# _ai_saveload_settings
	fread_str $fi, $ref_size;

	# _ai_saveload_version
	$$r{version} = fread_uint32 $fi, $ref_size;
    }
}


sub read_CHTS {
    my ( $fi, $ref_size, $ref_game ) = @_;

    $$ref_game{cheats} = { used => [], active => [] };
    for (@CHEATS) {
	push @{ $$ref_game{cheats}{used} }, $_
	    if ( fread_uint8 $fi, $ref_size );
	push @{ $$ref_game{cheats}{active} }, $_
	    if ( fread_uint8 $fi, $ref_size );
    }

}


sub read_DATE {
    my ( $fi, $ref_size, $ref_game ) = @_;

    my $date = fread_uint32 $fi, $ref_size;

    # $date = days since year 0, day 0; Add_Delta_Days wants year 1, day 1, so subtract 365+1
    ( $$ref_game{year}, $$ref_game{month}, $$ref_game{day} ) = Add_Delta_Days( 1, 1, 1, $date - 366 );
}


sub read_GSDT {
    my ( $fi, $ref_size, $r ) = @_;

    # _game_saveload_name
    my $name = fread_str $fi, $ref_size;

    if ($name) {
	$$r{name} = $name;

	# _game_saveload_settings
	fread_str $fi, $ref_size;

	# _game_saveload_version
	$$r{version} = fread_uint32 $fi, $ref_size;
    }
}


sub read_NGRF {
    my ( $fi, $ref_size, $r ) = @_;

    # filename
    $$r{name} = fread_str $fi, $ref_size;

    # grfid
    $$r{grfid} = sprintf '%08X', unpack 'V', fread $fi, 4, $ref_size;

    # md5sum
    $$r{md5sum} = uc unpack 'H*', fread $fi, 16, $ref_size;

    # version
    $$r{version} = fread_uint32 $fi, $ref_size;
}


sub read_PATS {
    my ( $fi, $ref_size, $ref_game ) = @_;

    Readonly my @CURRENCY_TBL => qw(
        GBP USD EUR JPY ATS BEF CHF CZK DEM DKK ESP FIM FRF GRD HUF ISK
        ITL NLG NOK PLN RON RUR SIT SEK YTL SKK BRL EEK CUSTOM
    );
    Readonly my @INDUSTRY_DENSITY => ( 'funding only', 'minimal', 'very low', 'low', 'normal', 'high' );
    Readonly my @SPEED => ( 'very slow', 'slow', 'medium', 'fast', 'very fast' );
    Readonly my @TERRAIN => ( 'very flat', 'flat', 'hilly', 'mountainous', 'alpinist' );
    Readonly my @SEA_LEVEL => ( 'very low', 'low', 'medium', 'high', 'custom' );
    Readonly my @BREAKDOWNS => qw( none reduced normal );
    Readonly my @TOLERANCE => qw( permissive tolerant hostile );
    Readonly my @CLIMATE => ( 'temperate', 'sub-arctic', 'sub-tropical', 'toyland' );
    Readonly my @ROADSIDE => qw( left right );
    Readonly my @SCALE3 => qw( low medium high );

    # difficulty.max_no_competitors
    $$ref_game{competitors} = fread_uint8 $fi, $ref_size;

    # difficulty.number_towns
    fskip $fi, 1, $ref_size;

    # difficulty.industry_density
    $$ref_game{industry_density} = $INDUSTRY_DENSITY[(fread_uint8 $fi, $ref_size)];

    # difficulty.max_loan
    $$ref_game{max_loan} = fread_uint32 $fi, $ref_size;

    # difficulty.initial_interest
    $$ref_game{interest} = fread_uint8 $fi, $ref_size;

    # difficulty.vehicle_costs
    $$ref_game{running_costs} = $SCALE3[(fread_uint8 $fi, $ref_size)];

    # difficulty.competitor_speed
    $$ref_game{competitor_speed} = $SPEED[(fread_uint8 $fi, $ref_size)];

    # difficulty.vehicle_breakdowns
    $$ref_game{breakdowns} = $BREAKDOWNS[(fread_uint8 $fi, $ref_size)];

    # difficulty.subsidy_multiplier
    $$ref_game{subsidy_multiplier} = fread_uint8 $fi, $ref_size;

    # difficulty.construction_cost
    $$ref_game{construction_costs} = $SCALE3[(fread_uint8 $fi, $ref_size)];

    # difficulty.terrain_type
    $$ref_game{terrain_type} = $TERRAIN[(fread_uint8 $fi, $ref_size)];

    # difficulty.quantity_sea_lakes
    $$ref_game{sea_level} = $SEA_LEVEL[(fread_uint8 $fi, $ref_size)];

    # difficulty.economy
    $$ref_game{recessions} = fread_uint8 $fi, $ref_size;

    # difficulty.line_reverse_mode
    fskip $fi, 1, $ref_size;

    # difficulty.disasters
    $$ref_game{disasters} = fread_uint8 $fi, $ref_size;

    # difficulty.town_council_tolerance
    $$ref_game{tolerance} = $TOLERANCE[(fread_uint8 $fi, $ref_size)];

    # game_creation.town_name
    fskip $fi, 1, $ref_size;

    # game_creation.landscape
    $$ref_game{climate} = $CLIMATE[(fread_uint8 $fi, $ref_size)];

    # vehicle.road_side
    $$ref_game{roadside} = $ROADSIDE[(fread_uint8 $fi, $ref_size)];

    # game_creation.map_x
    # game_creation.map_y
    # game_creation.variety
    # game_creation.custom_sea_level
    # game_creation.tree_placer
    # construction.max_heightlevel
    # game_creation.snow_line_height
    # game_creation.tgen_smoothness
    # game_creation.amount_of_rivers
    # game_creation.land_generator
    # pf.yapf.rail_firstred_twoway_eol

    fskip $fi, 344, $ref_size;
    $$ref_game{currency} = $CURRENCY_TBL[(fread_uint8 $fi, $ref_size)] // 'GBP';
}


sub read_PLYR {
    my ( $fi, $ref_size, $ref_comp ) = @_;

    # name_2, name_1
    fskip $fi, 4 + 2, $ref_size;

    # name
    $$ref_comp{name} = fread_str $fi, $ref_size;
    $$ref_comp{name} = '<unknown>' if (!$$ref_comp{name});

    # president_name_1, president_name_2
    fskip $fi, 2 + 4, $ref_size;

    # president_name
    $$ref_comp{president_name} = fread_str $fi, $ref_size;
    $$ref_comp{president_name} = '<unknown>' if (!$$ref_comp{president_name});

    # face
    fskip $fi, 4, $ref_size;

    # money
    $$ref_comp{money} = fread_uint64 $fi, $ref_size;

    # current_loan
    $$ref_comp{current_loan} = fread_uint64 $fi, $ref_size;

    # colour, money_fraction, block_preview, location_of_HQ, last_build_coordinate
    fskip $fi, 3 + 4 + 4, $ref_size;

    # inaugurated_year
    $$ref_comp{inaugurated_year} = fread_uint32 $fi, $ref_size;

    # share_owners, num_valid_stat_ent
    fskip $fi, 4 + 1, $ref_size;

    # months_of_bankruptcy
    $$ref_comp{bankruptcy} = fread_uint8 $fi, $ref_size;

    # bankrupt_asked, bankrupt_timeout
    fskip $fi, 2 + 2, $ref_size;

    # bankrupt_value
    $$ref_comp{bankrupt_value} = fread_uint64 $fi, $ref_size;

    # costs
    for ( 0 .. 2 ) {
	my $r = $$ref_comp{costs}{$_} = [];
	push @$r, -fread_uint64 $fi, $ref_size for (@COST_NAMES);
    }

    # is_ai
    $$ref_comp{is_ai} = fread_uint8 $fi, $ref_size;

    # terraform_limit
    $$ref_comp{terraform_limit} = fread_uint32h $fi, $ref_size;

    # clear_limit
    $$ref_comp{clear_limit} = fread_uint32h $fi, $ref_size;

    # tree_limit
    $$ref_comp{tree_limit} = fread_uint32h $fi, $ref_size;
}


sub scan {
    my ( $fn, $ref_game, $ref_company ) = @_;

    open my $fi, '<:unix', $fn
	or croak qq(can't open file $fn: $!);
    binmode $fi;

    my $id = unpack 'A4', fread $fi, 4;
    croak qq(Unsupported savegame format $id)
	unless $id eq 'OTTN';

    $$ref_game{version} = fread_uint32h $fi;
    croak qq(Unsupported version $$ref_game{version})
	if $$ref_game{version} < 178;

    my $chunk = 0;
    while (1) {
	$id = unpack 'a4', fread $fi, 4;
	last if $id eq "\0" x 4;

	my $type = fread_uint8 $fi;

	if ( ( $type & 0xF ) == CH_RIFF ) {
	    my $size = unpack 'N', chr ( $type >> 4 ) . unpack 'a3', fread $fi, 3;
	    if ($size) {
		if ($id eq $opt{s}) {
		    save_chunk $fi, $size, $id, $chunk;
		    $size = 0;
		}
		elsif ( exists $HANDLERS{$id} )  {
		    $HANDLERS{$id}( $fi, \$size, $ref_game );
		}
                elsif ( $opt{d} ) {
                    print STDERR qq(Unhandled $id ($size bytes)\n);
                }
	    }
	    fskip $fi, $size;
	}
	elsif ( $type == CH_ARRAY or $type == CH_SPARSE_ARRAY ) {
	    my $idx = 0;
	    while ( ( my $size = read_gamma($fi) - 1 ) >= 0 ) {
		if ($size) {
		    if ( $id eq $opt{s} ) {
			save_chunk $fi, $size, $id, $chunk, $idx;
			$size = 0;
		    }
		    elsif ( exists $HANDLERS{$id} ) {
			my $r;

                        if ($id ne 'PLYR') {
			    if ( grep $id, @SINGLE_CHUNKS ) {
				$$ref_game{$id} //= [];
				$r = $$ref_game{$id};
			    }
			    else {
				$$ref_game{$id} //= {};
				$$ref_game{$id}{$chunk} //= [];
				$r = $$ref_game{$id}{$chunk};
			    }
			}
			else {
			    $r = $ref_company;
			}
			$$r[$idx] = {};
			$HANDLERS{$id}( $fi, \$size, $$r[$idx] );
			undef $$r[$idx] if (!%{$$r[$idx]});
		    }
                    elsif ( $opt{d} ) {
                        print STDERR "Unhandled $id " . ( $type == CH_ARRAY ? 'array' : 'sparse_array' ) . " ($size bytes)\n";
                    }
		}
		$idx++;
		fskip $fi, $size;
	    }
	}
	else {
	    croak qq(Unknown chunk $id type $type);
	}

	$chunk++ if ( $id eq $opt{s} );
    }

    close $fi
	or croak qq(can't close file $fn: $!);
}


sub convert_currency {
    my ( $money, $currency ) = @_;

    Readonly my %CURRENCY_MUL => (
	ATS    => 27,
	BEF    => 81,
	BRL    => 4,
	CHF    => 2,
	CUSTOM => 1,
	CZK    => 41,
	DEM    => 4,
	DKK    => 11,
	EEK    => 31,
	ESP    => 333,
	EUR    => 2,
	FIM    => 12,
	FRF    => 13,
	GBP    => 1,
	GEL    => 3,
	GRD    => 681,
	HUF    => 378,
	IRR    => 4901,
	ISK    => 130,
	ITL    => 3873,
	JPY    => 220,
	KRW    => 1850,
	LTL    => 4,
	NLG    => 4,
	NOK    => 12,
	PLN    => 6,
	RON    => 5,
	RUR    => 50,
	SEK    => 13,
	SIT    => 479,
	SKK    => 60,
	TRY    => 3,
	USD    => 2,
	ZAR    => 13,
    );

    return $money * ( $CURRENCY_MUL{$currency} // 1 );
}


sub summary {
    my ( $ref_game, $ref_company ) = @_;

    my $TEMPLATE = q(
Date:               [%- game.year %] [% month(game.month) %] [% game.day %]
Savegame version:   [% game.version %]
Climate:            [% game.climate %]
Terrain type:       [% game.terrain_type %]
Sea level:          [% game.sea_level %]
No. of industries:  [% game.industry_density %]
Vehicles drive on:  [% game.roadside %]

Council's attitude: [% game.tolerance %]
Disasters:          [% bool(game.disasters) %]

Construction costs: [% game.construction_costs %]
Running costs:      [% game.running_costs %]
Breakdowns:         [% game.breakdowns %]

Recessions:         [% bool(game.recessions) %]
Maximum loan:       [% money(game.max_loan) %]
Interest rate:      [% game.interest %]%
Subsidy multiplier: [% game.subsidy_multiplier %]
[% IF game.competitors -%]

AI Competitors:     [% game.competitors %]
Competitor speed:   [% game.competitor_speed %]
[% END -%]
[% IF game.cheats.used.list.size -%]
Cheats used:        [% game.cheats.used.join(', ') %]
Cheats active:      [% game.cheats.active.join(', ') %]
[% END -%]
[% IF is_useful(game.NGRF) -%]

NewGRFs:

[% FOREACH item = game.NGRF -%]
[% loop.count %]. [% item.grfid %] [% item.name %] version [% item.version %] ([% item.md5sum %])
[% END -%]
[% END -%]
[% IF is_useful(game.AIPL) -%]

AIs:

[% FOREACH item = game.AIPL -%]
[% IF item.name.defined -%]
[% loop.count %]. [% item.name %] version [% item.version %]
[% END -%]
[% END -%]
[% END -%]
[% IF is_useful(game.GSDT) -%]

Game scripts:

[% FOREACH item = game.GSDT -%]
[% IF item.name.defined -%]
[% loop.count %]. [% item.name %] version [% item.version %]
[% END -%]
[% END -%]
[% END -%]

Companies:
[% FOREACH item = company -%]
[% IF item.name.defined -%]

[% loop.count %]. [% item.name %] ([% item.president_name %])[% " [AI]" IF item.is_ai %]
Inaugurated:    [% item.inaugurated_year %]
Balance:        [% money(item.money) %]
[% IF item.current_loan -%]
Loan:           [% money(item.current_loan) %]
[% END -%]
[% IF item.bankrupt_value -%]
Bankrupt value: [% money(item.bankrupt_value) %]
[% END -%]
[% END -%]
[% END -%]
);
    my $tt = Template->new()
	or croak qq($Template::ERROR\n);
    $tt->process(
	$opt{t} // \$TEMPLATE, {
	    game      => $ref_game,
	    company   => $ref_company,
	    bool      => sub { qw( off on ) [ $_[0] ]; },
	    money     => sub {
		format_number( convert_currency $_[0], $$ref_game{currency} ) . ' ' . $$ref_game{currency};
	    },
	    is_useful => sub {
		scalar grep { defined ($_) } @{ $_[0] };
	    },
	    month     => sub { Month_to_Text( $_[0] ) },
	}
    ) or croak $tt->error();

    # print Dumper($ref_game);
}


sub save_csv {
    my ( $c, $date, $currency ) = @_;
    my ( $fo, @names );

    croak qq(unknown company #$opt{c})
	unless defined $c;
    my $csv = Text::CSV->new( { eol => "\n" } );

    if ( $opt{o} ) {
	unless ( -f $opt{o} ) {
	    @names = qw( date money loan bankrupt_val );
	    for my $idx ( 0 .. 2 ) {
		push @names, map { $_ . '_' . $idx } @COST_NAMES;
	    }
	}

	open $fo, '>>', $opt{o}
	    or croak qq(can't open file $opt{o}: $!);
	print $fo +( join ',', @names ), "\n" if @names;
    }
    else {
	$fo = \*STDOUT;
    }

    my $values = [ $$c{money}, $$c{current_loan}, $$c{bankrupt_value} ];
    push @$values, @{ $$c{costs}{$_} } for ( 0 .. 2 );
    @$values = map { convert_currency $_, $currency } @$values;
    unshift @$values, $date;
    $csv->print( $fo, $values );

    if ( $opt{o} ) {
	close $fo
	    or croak qq(can't close file $opt{o}: $!);
    }
}


$pname = basename $0;

$opt{s} = '';
$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts 'c:dho:s:t:v', \%opt;
if ( $opt{v} ) { VERSION_MESSAGE \*STDERR; exit 1; }
usage if ( $opt{h} or @ARGV < 1 or !-f $ARGV[0] );
binmode \*STDOUT, ':encoding(UTF-8)';

scan $ARGV[0], \%game, \@company;
summary \%game, \@company if ( !$opt{s} and !$opt{c} and !$opt{d} );
save_csv $company[ $opt{c} - 1 ], ( sprintf '%04d/%02d/%02d', $game{year}, $game{month}, $game{day} ), $game{currency}
    if ( $opt{c} );

ottd_unpack.pl

#!/usr/bin/env perl
#
# Copyright (c) 2016, LCD 47 <lcd047@gmail.com>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#

use v5.12;
use strict;
use warnings;

use File::Basename;
use Getopt::Std;
use IO::Uncompress::UnLzma;
use IO::Uncompress::RawInflate;
use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError);
use Carp qw(croak);

our $VERSION = '0.2';
my ( $pname, %opt, $fi, $fo );


sub HELP_MESSAGE {
    print STDERR <<EOT ;
Usage: $pname [-h] [-v] <packed> [<unpacked>]
 -v	- print version and exit
 -h     - print this help and exit
EOT
    exit 1;
}


sub VERSION_MESSAGE {
    my $out = shift;
    print $out qq($pname $VERSION\n);
}


sub usage {
    HELP_MESSAGE \*STDERR;
}


sub fread {
    my ( $f, $len ) = @_;
    my $buf;

    ( sysread $f, $buf, $len ) == $len
	or croak qq(can't read $len bytes: $!);
    return $buf;
}


sub fwrite {
    my ( $f, $buf ) = @_;
    my $len = length $buf;

    ( syswrite $f, $buf, $len ) == $len
	or croak qq(can't write $len bytes: $!);
}


$pname = basename $0;

$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts 'hv', \%opt;
if ( $opt{v} ) { VERSION_MESSAGE \*STDERR; exit 1; }
usage if ( $opt{h} or @ARGV < 1 or @ARGV > 2 );

if ( $ARGV[0] ne '-' ) {
    usage unless -f $ARGV[0];
    open $fi, '<', $ARGV[0]
	or croak qq(can't open $ARGV[0]: $!);
}
else {
    $fi = \*STDIN;
}
if ( @ARGV == 2 and $ARGV[1] ne '-' ) {
    open $fo, '>', $ARGV[1]
	or croak qq(can't open $ARGV[1]: $!);
}
else {
    $fo = \*STDOUT;
}

binmode $fi;
binmode $fo;

my $id  = unpack 'A4', fread $fi, 4;
my $ver = unpack 'N',  fread $fi, 4;

fwrite $fo, pack 'A4', 'OTTN';
fwrite $fo, pack 'N',  $ver;

anyuncompress $fi => $fo,
    BinModeOut    => 1,
    RawInflate    => 1,
    UnLzma        => 1,
    AutoClose     => 1
    or croak "anyuncompress failed: $AnyUncompressError\n";