#!/usr/bin/perl -CSDAL

use strict;
use warnings;
use utf8;

my $verbose= 0;
if( @ARGV && $ARGV[0] eq "-v" ) {
    $verbose= 1;
    shift @ARGV;
    if( @ARGV && $ARGV[0] eq "-v" ) {
        ++$verbose;
        shift @ARGV;
    }
}

if( @ARGV != 1 || $ARGV[0] =~ /^--?h(?:elp)?$/ ) {
    print <<EOF;
usage: urfcheck.pl [ -v ] <urf file>
Outputs header information, notes pixel coding errors and outputs a PPM file to
/tmp.  With -v, prints file offsets of encoded rows.  With -v given twice, also
prints file offsets of encoded pixel sequences.
EOF
    exit;
}

open IN, "<", $ARGV[0];
binmode IN;

my $data;
read IN, $data, 44 or die "Error reading URF header: $!\n";

my ($magic, $pages, $bpp, $colspace, $duplex, $quality, $mediatype, $mediapos, $pad6b, $w, $h, $dpi, $pad8b)= unpack("a8NC6a6N3a8", $data);

my @quality= ( "auto", undef, undef, "draft", "normal", "high" );
my @colourspace= qw( sGray sRGB CieLab AdobeRGB Gray32 RGB CMYK );
my @duplex= qw( no shortside longside );
my @mediatype= qw( auto stationery transparency envelope cardstock labels
    stationery letterhead disc matte satin semigloss gloss highgloss other );
my @mediaposition= qw( auto main alternate large capacity manual envelope
    disc photo hagaki main roll alternate roll top middle bottom side left
    right center rear bypass tray1 tray2 tray3 tray4 tray5 tray6 tray7 tray8
    tray9 tray10 tray11 tray12 tray13 tray14 tray15 tray16 tray17 tray18 tray19
    tray20 roll1 roll2 roll3 roll4 roll5 roll6 roll7 roll8 roll9 roll10 );

$magic =~ s/\0+$//;
$quality= $quality[$quality] if defined $quality[$quality];
$colspace= $colourspace[$colspace] if defined $colourspace[$colspace];
$duplex= $duplex[$duplex] if defined $duplex[$duplex];
$mediatype= $mediatype[$mediatype] if defined $mediatype[$mediatype];
$mediapos= $mediaposition[$mediapos] if defined $mediaposition[$mediapos];

print <<EOF;
URF header information:
Magic:  $magic
Nr of pages:  $pages
Bits per pixel:  $bpp
Colour space:  $colspace
Duplex:  $duplex
Quality:  $quality
Media type:  $mediatype
Media position:  $mediapos
Image size:  $w x $h
Resolution:  $dpi DPI
EOF

die "Magic word does not indicate URF format - not trying to decode\n"
    unless $magic eq "UNIRAST";

$data= "";
my $bypp= int(($bpp + 7) / 8);
my $maxrowsize= 1 + (1 + $bpp) * $w;
my $y= 0;
my $codeerr;

my $outfname= "/tmp/urfcheck-$$." . ($bypp > 2 ? "ppm":"pgm");
my $out;
if( $bypp != 3 && $bypp != 1 ) {
    print "Warning: only 1 and 3 bytes per pixel supported for conversion to PNM\n";
}
else {
    open $out, ">", $outfname or die "Cannot create output file $outfname: $!\n";
    print $out ($bypp == 1 ? "P5":"P6"), "\n$w $h\n255\n";
    binmode $out;
}

while( $y < $h ) {
    if( length ($data) < $maxrowsize ) {
        my $status= read IN, $data, $maxrowsize - length($data), length($data);
        die "Error reading pixel data: $!\n" unless defined $status;
    }
    my $rowstartoff= tell(IN) - length($data);
    print sprintf("%08X", $rowstartoff), ": row $y\n" if $verbose;
    my $rowrepeat= 1 + unpack("C", substr($data, 0, 1, ""));
    my $decrow= "";
    my $x= 0;
    my ($seqstartx, $seqstartoff);
    while( $x < $w ) {
        $seqstartx= $x;
        $seqstartoff= tell(IN) - length($data);
        print "  ", sprintf("%08X", $seqstartoff) if $verbose > 1;
        die sprintf("%08X", $seqstartoff) . ": Data for row $y incomplete at column $x\n"
            unless length($data) >= 1 + $bypp;
        my $pixcount= unpack("C", substr $data, 0, 1, "");
        if( $pixcount <= 0x7F ) {       # run-length sequence
            ++$pixcount;
            my $pixel= substr $data, 0, $bypp, "";
            if( $out ) {
                $decrow .= $pixel for (1 .. $pixcount);
            }
        }
        elsif( $pixcount >= 0x81 ) {    # verbatim sequence
            $pixcount= 257 - $pixcount;
            if( $out ) {
                $decrow .= substr($data, 0, $pixcount * $bypp, "");
            }
            else {
                substr($data, 0, $pixcount * $bypp, "");
            }
        }
        else {
            die "Encountered pixel count value 0x", sprintf("%02X", $pixcount), " with unknown meaning\n";

        }
        $x += $pixcount;
    }
    print "\n" if $verbose > 1;
    print sprintf("%08X", $seqstartoff), ": Sequence from column $seqstartx to ", $x-1, " extends beyond end of row $y\n"
        if $x > $w;
    if( $out ) {
        print $out $decrow for (1..$rowrepeat);
    }
    print "Row repeat from row $y exceeds image by ", $y + $rowrepeat - $h, " rows\n"
        if $y + $rowrepeat > $h;
    $y += $rowrepeat;
    $codeerr= 1 if $x > $w || $y > $h;
}

print "Decoding successful\n" unless $codeerr;
print "Trailing pixel data\n" if tell(IN) - length($data) < -s $ARGV[0];

close $out if $out;
close IN;

