#!/usr/bin/perl -w
use strict; use warnings;
use Encode;
use Cwd;
use File::Copy;

#my ($path) = @ARGV; #use this to pass path as argument
#my ($path) = 'C:/TMP/wow/'; #use this to force path
my ($path) = cwd(); #use this to set path = current directory
#print $path . "\n";

#makes archive and output directories if they don't exist
my $dirout = $path . "/output";
my $dirarc = $path . "/archive";
mkdir $dirout;
mkdir $dirarc;

$path // die "No path specified";
(-e $path) or die "Path not found: $path";
(-d $path) or die "Not a directory: $path";

my @files = <$path/*.x937>;

foreach my $file (@files) {
   process($file);
}

sub process {
    my ($fname) = @_;

    my ($dir, $file) = $fname =~ m{^(.*)/(.+)$};

    my $tiff_flag = 0;
    my $count = 0;


    my $outfile = sprintf("%s/output/%s_0.txt", $dir, $file);
    $outfile =~ s/.x937//;
    while (-e $outfile) {
    $outfile =~ s/([0-9]+).txt/$1 + 1/e;
    $outfile = $outfile . ".txt";
    }

    my $mfname = sprintf("%s/archive/%s_0.x937", $dir, $file);
    $mfname =~ s/.x937_/_/;
    while (-e $mfname) {
    $mfname =~ s/([0-9]+).x937/$1 + 1/e;
    $mfname = $mfname . ".x937";
    }

    open (my $outfh, '>', $outfile) or die "Unable to create $outfile. $!";

    open (my $infh, '<:raw', $fname) or die "Error opening '$file'. $!";


    my $buffer = undef;

    while (read ($infh,$buffer,4)) {
        my $rec_len = unpack("N", $buffer);
        die "Bad record length: $rec_len" unless ($rec_len > 0);
        read ($infh, $buffer, $rec_len);

        if (substr($buffer, 0, 2) eq "\xF5\xF2") {
            if ($tiff_flag) {
                $count++;
                my $tiff_filename = sprintf('%s/output_%s_img%04d.tiff', $dir, $file, $count);
                open (my $tiffh, '>', $tiff_filename) or die "Can't create image file $!";
                binmode($tiffh) or die 'Error setting binary mode on image file';
                print $tiffh substr($buffer, 117);
                close $tiffh;
            }
            $buffer = substr($buffer, 0, 117);
        }
        print $outfh decode ('cp1047', $buffer) . "\n";
    }
    close $infh;
    close $outfh;

    move($fname,$mfname) or die "Move failed: $!";
}