#!/usr/bin/perl

# Panasonic KX-TA624 Batch Loader
# Copyright 2006 Russ Price
#
# This program will load a configuration dump file
# (as created by kxdump) into a Panasonic KX-TA624 PBX.
#
# $Id: kxbatch,v 1.3 2006/08/09 15:58:31 root Exp $
# $Log: kxbatch,v $
# Revision 1.3  2006/08/09 15:58:31  root
# Better handling of blank lines and Unix-format text
#
# Revision 1.2  2006/08/08 21:58:26  root
# Replace a 000S line (system date/time setting) with current date and time.
#
# Revision 1.1  2006/08/07 22:17:06  root
# Initial revision
#


use Device::SerialPort 0.12;

sub usage {
	print STDOUT "\nUsage: $0 pass infile\n\npass is the Panasonic system password\n\ninfile is the configuration dump file to load\n\n";
	exit(1);
}

if(scalar @ARGV != 2) { usage(); }

($pwd, $loadfile) = @ARGV;

$SIG{'INT'} = \&death;
$SIG{'TERM'} = \&death;

$|++;
$PORT      = "/dev/ttyS0";          # port to use
$BAUD = 9600;
$PARITY = "none";
$BITS = 8;
$FLOW = "xoff";

sub death {
undef $ob;
print STDOUT "Shut down.\n";
close;
exit(0);
}

# Open serial port.

$ob = Device::SerialPort->new ($PORT) || die "Can't Open $PORT: $!";
$ob->baudrate($BAUD)   || die "failed setting baudrate";
$ob->parity($PARITY)   || die "failed setting parity";
$ob->databits($BITS)   || die "failed setting databits";
$ob->handshake($FLOW)  || die "failed setting handshake";
$ob->write_settings    || die "no settings";

# Send a CR to wake the system up, and be sure to soak up
# any character that might be waiting.

$pass=$ob->write("\r");
sleep 1;

# We're going to use regular file I/O here on out.
open(DEV, "+<$PORT") 
    || die "Cannot open $PORT: $_";

$foo = getc(DEV);
print "Beginning batch load operation\n";

# csend: Sends a command to the PBX. Waits for each character
# to be echoed to prevent overrunning the PBX's limited or
# non-existent input buffer.

sub csend($) {
	my ($cmd) = @_;
	my $i;
	my $len = length $cmd;
	my $out, $in;

	$cmd .= "\r";

	for($i=0; $i<$len; $i++) {
		$out = substr($cmd, $i, 1);
		print DEV $out;
		$in = getc(DEV);
		if($in ne $out) {
			print STDOUT "Command [$cmd] failed.\n";
			exit(1);
		}
		if($in eq '\r') { $in = getc(DEV); }
	}
}

# waitfor: Wait for a command prompt string.
# No capture facility provided.  CR/LF may be used in prompt.
sub waitfor {
	my ($match) = @_;
	my $mcount = 0, $c;
	my $max = length $match;

	do {
		$c = getc(DEV);
		if($c eq substr($match, $mcount, 1)) { $mcount++; }
	} while($mcount < $max);
}

sub kxtime {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	my $hr12 = ($hour % 12);
	$hr12 = 12 if (!$hr12);
	my $pm = ($hour >= 12) ? 1 : 0;
	my $ret = sprintf("000S/%02d%02d%02d%1d,%02d%02d%1d/\r\n",
		$year % 100, $mon + 1, $mday, $wday, $hr12, $min, $pm);
	return $ret;
}

# dsend: Send a batch-mode data line to the PBX.  The PBX doesn't
# echo data until AFTER it receives the CR.
sub dsend ($) {
	my ($line) = @_;
	my $last;

	# Unix-format input?
	if(!($line =~ m/\r\n$/o)) { $line =~ s/\n$/\r\n/o };

	# Blank lines, comment lines
	if(($line =~ m/^\r/o) || ($line =~ m/^;/o)) { return 0 };

	# Is it a time setting?  If so, replace with current time
	if(($line =~ m/^000S\//o)) {
		$line = kxtime();
		print STDOUT "Replacing time setting in file with current time (" . scalar localtime() . ")\n";
	}

	# Don't send the \n to the PBX
	$last = chop $line;
	print DEV $line;
	if(($line =~ m/^EOD/o)) {
		waitfor("; Batch data end\r\n\r\n");
		return 1;
	} else {
		# Get our \n back
		$line .= $last;
		# Wait for acknowledgement
		waitfor($line);
		return 0;
	}
}

sub sendfile($) {
	my ($file) = @_;
	my $linecount = 0;

	open(DATA, "<$file") || die("$!");
	while(<DATA>) {
		printf(STDOUT "Lines sent: %d\r", ++$linecount);
		last if dsend($_);
	}
	print STDOUT "\n";
	close DATA;
}
	
print STDOUT "Establishing contact with PBX on $PORT\n";
csend("TA624\r");		# magic sequence to activate PBX command interface
waitfor(";>");
csend("EDT\r");		# enter Dump mode
waitfor("Password : \026");
csend("$pwd\r");		# send password
waitfor(";>");
csend("FIL\r");
# We must wait for BOTH CRLFs here. The PBX does NOT
# support typeahead.
waitfor("<Transmit the batch data>\r\n\r\n");
sendfile($loadfile);
waitfor(";E>");
csend("BYE\r");		# tell PBX to resume normal operation
print STDOUT "Upload completed.\n";

undef $ob;