#!/usr/bin/env perl

# Copyright (C) 2008 John R. Hogerhuis
#
# this script will transfer a file to a TPDD drive.
# 
# -f=filename [-p=port-device] [-d=debug-level] [-n convert-newlines]
# 
# make sure to use Win32::SerialPort instead of Device::SerialPort
# on Windows.

use strict;

use Device::SerialPort;
# On Windows, use this instead:
# use Win32::SerialPort
use File::Spec;

use Data::Dumper;
use Data::HexDump;

use constant CMD_T_DIR		=> 0;
use constant CMD_T_OPEN		=> 1;
use constant CMD_T_WRITE	=> 4;
use constant CMD_T_DELETE	=> 5;
use constant CMD_T_CLOSE	=> 2;

my %params = (Port => '/home/john/temp/vmodemOUT');
#my %params = (Port => '/dev/ttyUSB1');

# process command line arguments
foreach my $parm (@ARGV) {
	my ($name, $value) = split ('=', $parm);
	if ($name eq '-p') {
		$params{Port} = $value;
	} elsif ($name eq '-d') {
		$params{Debug} = $value ? $value + 0 : 1;
	} elsif ($name eq '-f') {
		$params{FPath} = $value;
	} elsif ($parm eq '-n') {
		$params{ConvertNL} = 1;
	} elsif ($parm =~ /\?|help/i) {
		$params{Help} = 1;
		last;
	}
}

if ($params{Help} || !exists $params{FPath}) {
	print STDERR "create_file.pl ";
	print STDERR "-f=path-to-file  [-p=com-port]  [-n] convert newlines  ";
	print STDERR "[-d=debug-level]";
	print STDERR "\n";
	exit;
}

my $port = new Device::SerialPort ($params{Port})
	|| die "Cannot open port ". $params{Port};

$port->baudrate (19200);
$port->parity	("none");
$port->databits (8);
$port->stopbits (1);
$port->handshake ('rts');
$port->read_const_time(2500);       # 500 milliseconds = 0.5 seconds
$port->read_char_time(2500);          # avg time between read char
$port->write_settings;
$port->dtr_active('T');

sub min {
	return $_[0]<$_[1] ? $_[0] : $_[1];
}

sub sum {
	my $total = 0;
	foreach (@_) {	
		$total += $_;
	}
	return $total;
}

sub csum {
	my $data = shift;
	return pack ('C', (sum (
		map {ord ($_)} split (//, $data)
		) & 0xFF) ^ 0xFF);
}


sub fname2tpdd {
	my $fname = shift;

	my ($left, $right) = split (/\./, $fname);

	my $tpdd_name = pack ("A6AA2", $left, '.', $right);
	return $tpdd_name . ' 'x(24-length($tpdd_name));
}

sub write_req {
	my ($ser, $cmd, $body) = @_;
	$body = chr($cmd) . chr (length ($body)) . $body;
	my $msg = 'ZZ' . $body . csum ($body);
	$params{Debug} && print STDERR HexDump ($msg), "\n";
	$ser->write ($msg);
}

sub read_rsp {
	my $ser = shift;

	my $rsp = $ser->read (2);
	if (defined $rsp) {
		$rsp .= $ser->read (ord (substr($rsp, 1, 1)) + 1);
	}
	$params{Debug} && print STDERR HexDump($rsp), "\n";
	return ($rsp);
}

sub transact {
	my ($ser, $cmd, $body) = @_;
	$body = $body || '';
	write_req ($ser, $cmd, $body);
	return read_rsp ($ser);
}

sub pick_file {
	my ($ser, $fname) = @_;
	my $tpdd_padded = fname2tpdd ($fname);

	return transact ($ser, CMD_T_DIR, fname2tpdd ($fname) . "F\x00");
}

sub open_for_write {
	my ($ser) = @_;
	my $rsp = transact ($ser, CMD_T_OPEN, chr(1));
}

sub write_all {
	my ($ser, $str) = @_;
	while (my $len = length ($str)) {
		my $left = substr ($str, 0, min ($len, 128), '');
		transact ($ser, CMD_T_WRITE, $left); 
	}
}

sub xfer {
	my ($ser, $path) = @_;

	# select the file
	my ($vol, $dir, $name) = File::Spec->splitpath ($path);
	$name = uc $name;
	my $rsp = pick_file ($port, $name);

	# delete the file if already exists
	if (ord (substr ($rsp, 2, 1)) != 0) {
		transact ($ser, CMD_T_DELETE);
		$rsp = pick_file ($ser, $name);
	}

	# slurp in file, convert newlines to m100 style if requested
	local( *FH ) ;
	open( FH, $path ) or die "sudden flaming death\n";
	my $data = do { local( $/ ) ; <FH> } ;
	if ($params{ConvertNL}) {
		$data =~ s/\n/\x0d\x0a/gs;
	}

	open_for_write ($ser);
	write_all ($ser, $data);

	transact ($ser, CMD_T_CLOSE);
}

xfer ($port, $params{FPath});

$port->close();