#! /usr/bin/perl
#---------------------------------------------------------------------
# compact.pl
# Copyright 2006 Christopher J. Madsen
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# Simple Run-Length-Encoded file compression
#
# Usage: compact.pl INFILE OUTFILE
#---------------------------------------------------------------------

use strict;
use bytes;
use IO::All;

#---------------------------------------------------------------------
open OUT, '>', $ARGV[1] or die $!;
binmode OUT;

#---------------------------------------------------------------------
sub printChunk
{
  my $chunk = $_[0];

  while (length $chunk > 0xFFFF) {
    print OUT "\xFF\xFF" . substr($chunk, 0, 0xFFFF, '') . "\0\0";
  } # end while too much data for a single chunk

  print OUT pack('n', length($chunk)) . $chunk;
} # end printChunk

#---------------------------------------------------------------------
sub printNulls
{
  my $nulls = $_[0];

  while ($nulls > 0xFFFF) {
    print OUT "\xFF\xFF\0\0";
    $nulls -= 0xFFFF;
  } # end while too many nulls for a single count

  print OUT pack('n', $nulls);
} # end printNulls

#=====================================================================
# A compressed file just alternates between a count of null bytes and
# a data chunk (count + raw data).  All counts are unsigned network
# shorts.

my $data = io($ARGV[0])->binmode->scalar;

my $nulls = 0;

$nulls = $+[0] - $-[0] if $data =~ s/^\0+//;

printNulls($nulls);

while ($data =~ s/^([^\0].*?)\0{4,}(?=[^\0]|$)//s) {
  $nulls = $+[0] - $+[1];
  printChunk($1);

  printNulls($nulls);
}

printChunk($data) if length $data;

close OUT;