#!/usr/local/bin/perl
use FindBin;
use lib "$FindBin::Bin/../lib";
use lib "$FindBin::Bin/../../Parse-Binary/lib";

use strict;
use Parse::AFP;
use Parse::AFP::PTX;
use Getopt::Std;
use File::Path 'rmtree';

{
package Parse::AFP::Record;
sub new {
    my ($self, $buf, $attr) = @_;
    if (substr($$buf, 3, 3) eq "\xD3\xEE\x9B") {
        return bless($buf, 'PTX');
    }
    return $self->SUPER::new($buf, $attr);
}
sub PTX::done { return }
sub PTX::callback { main::PTX($_[0], $_[0]) }
}

my %NoUDC = (
    947 => qr{
        ^
            (?:
                [\x00-\x7f]+
            |
                (?:[\xA1-\xC5\xC9-\xF9].)+
            |
                (?:\xC6[^\xA1-\xFE])+
            )*
        $
    }x,
    835 => qr{^[^\x92-\xFE]*$}x,
);

my %opts;
getopts('i:o:c:', \%opts);
my $input       = $opts{i} || shift;
my $output      = $opts{o} || shift || 'udcdir';
my $codepage    = $opts{c} || 947;

die "Usage: $0 -c [947|835] -i input.afp -o udcdir\n"
    if grep !defined, $input, $codepage, $output;

rmtree([ $output ]) if -d $output;

my $NoUDC = $NoUDC{$codepage} or die "Unknown codepage: $codepage\n";
my ($has_udc, $name, $prev, $has_BNG, $PTX_cnt);
$name = $prev = 0;

mkdir $output;
my $afp = Parse::AFP->new($input, { lazy => 1, output_file => "$output/0" });
$afp->callback_members([qw( BMO BNG BPG PTX * )]);

if ($has_udc) {
    rename("$output/$name" => "$output/$name.udc") or die $!;
}

sub BNG {
    $prev = $name; $name++;
    $has_BNG = 1;

    $afp->set_output_file("$output/$name");

    if ($has_udc) {
        print STDERR '.';
        rename("$output/$prev" => "$output/$prev.udc") or die $!;
        $has_udc = 0;
    }

    $_[0]->done;
}

BEGIN { *BMO = *BPG; }

sub BPG {
    if( !$has_BNG ) {

	$prev = $name; $name++;
	$afp->set_output_file("$output/$name");

	if ($has_udc) {
	    print STDERR '.';
	    rename("$output/$prev" => "$output/$prev.udc") or die $!;
	    $has_udc = 0;
	}
    }
    else {
	$has_BNG = 0;
    }	

    $_[0]->done;
}

sub PTX {
    my ($rec, $buf) = @_;

    return $rec->done if $has_udc;

    # Now iterate over $$buf.
    my $pos = 11;
    my $len = length($$buf);

    while ($pos < $len) {
        my ($size, $code) = unpack("x${pos}CC", $$buf);

        $size or die "Incorrect parsing: $pos\n";

        if ($code == 0xDA or $code == 0xDB) {
            if ( substr($$buf, $pos + 2, $size - 2) !~ /$NoUDC/o) {
                $has_udc = 1;
                last;
            }
        }

        $pos += $size;
    }

    $rec->done;
}

sub __ { $_[0]->done }