#!/usr/local/bin/perl

### paledit -- get/put phonebook info from/to Paldio 341S relatives.
###
### $Id: paledit,v 1.2 1999/01/13 07:57:14 nom Exp $
### Copyright (C) 1998-1999 Yoshinari NOMURA (nom@csce.kyushu-u.ac.jp)

$DEBUG = 0;
$VERSION = "\npaledit version 0.91.";
$optDEV  = "/dev/cuaa2";
@MAX_ENT = (150, 10, 70, 70);

################################################################
### option handling
################################################################

while ($ARGV[0] =~ /^-/){
    $opt = shift(@ARGV);

    if ($opt eq '-put'){
	$optPUT = 1;
    } elsif ($opt eq '-get'){
	$optGET = 1;
    } elsif ($opt eq '-dev'){
	$optDEV = shift(@ARGV);
    } else {
	usage();
    }
}
usage() if ($optPUT && $optGET) || (!$optPUT && !$optGET);

sub usage
{
    die "$VERSION\n" .
	"Copyright (C) 1998-1999 Yoshinari NOMURA " .
        "(nom\@csce.kyushu-u.ac.jp)\n" .
	"paledit may be copied only under the terms of GPL.\n\n" .
        "  Usage: paledit -put [-dev device] [filename...]\n" .
	"         paledit -get [-dev device] > filename\n";
}

################################################################
### open serial device
################################################################

($num, $max) = ATOpen("$optDEV");
print STDERR "Phonebook has $num entries.\n";

################################################################
### put/get and exit.
################################################################

if ($optPUT){
    @phoneBook = readPhonebook();
    put(@phoneBook);
} elsif ($optGET){
    get($num);
}

ATClose();
exit 0;

################################################################
### workhorse for get
################################################################

sub get
{
    my $num = shift;
    my ($i, $ret, $record, $name, $yomi, $f1, $tel1, $f2, $tel2, $info);
    my ($area, $cmc, $grp);
    
    for ($i = 1; $i <= $num; $i++){
	printf STDERR "Reading %3d/%-3d ...\n", $i, $num;

	$ret = ATComm("AT#BR65535/03", "CAUSE");
	if ($ret =~ /RECORD=(\d+)/){$record = $1;}
	if ($ret =~ /DATA=..(\S+)/){$name = hex2string($1);}

	$ret = ATComm("AT#BR$record/04", "CAUSE");
	if ($ret =~ /DATA=..(\S+)/){$yomi = hex2string($1);}

	$ret = ATComm("AT#BR$record/05", "CAUSE");
	if ($ret =~ /DATA=(\S+)/){
	    ($f1, $tel1, $f2, $tel2, $info) = unpackTel($1);
	}

	$ret = ATComm("AT#BR$record/06", "CAUSE");
	if ($ret =~ /DATA=(\S+)/){
	    ($area, $cmc) = unpackCMC($1);
	}

	$ret = ATComm("AT#BR$record/07", "CAUSE");
	if ($ret =~ /DATA=(\S+)/){$grp = $1;}

	printf("%1d%1s | %-12s | %-4s | %-3s%-11s | %-3s%-11s | %-5s%-11s\n",
	       $grp, $info, $name, $yomi,
	       $f1, $tel1, $f2, $tel2, $area, $cmc);
    }
}    

################################################################
### unpack data from 341S (get)
################################################################

sub unpackTel
{
    my $data = shift;
    my ($f1, $tel1, $f2, $tel2, $info);
    my ($len, $i);
    my %DIC = ('80', 's:' ,	'81', 'g:' ,	'82', 'x:', 
	       '83', ':' ,	'84', ':' , 	'90', 'IF' ,
	      );

    $data =~ s/^03(..)//;
    $len = hex($1);

    for ($i = 0; $i < $len; $i++){
	$data =~ s/^(..)//;
	if ($DIC{$1} eq 'IF'){
	    $info = '+';
	} elsif (defined $DIC{$1}){
	    $f1 = $DIC{$1};
	} else {
	    $tel1 .= pack('C', hex($1));
	}
    }

    $data =~ s/^(..)//;
    $len = hex($1);

    for ($i = 0; $i < $len; $i++){
	$data =~ s/^(..)//;
	if ($DIC{$1} eq 'IF'){
	    $info = '+';   # never occured
	} elsif (defined $DIC{$1}){
	    $f2 = $DIC{$1};
	} else {
	    $tel2 .= pack('C', hex($1));
	}
    }
    $tel1 =~ tr [\x1c] [R];
    $tel2 =~ tr [\x1c] [R];
    return ($f1, $tel1, $f2, $tel2, $info);
}

sub unpackCMC
{
    my $data = shift;
    my ($tel1, $flag1, $i, $len);
    my %DIC = ('92', 'B:',    '93', 'l:',
	       '94', ':',    '95', '֐:',
	       '96', 'k:',    '97', 'C:',
	       '98', ':',    '99', 'k:',
	       '9A', 'kC:',
	      );

    $data =~ s/^(..)//;
    $len = hex($1);

    for ($i = 0; $i < $len; $i++){
	$data =~ s/^(..)//;
	if (defined $DIC{$1}){
	    $flag1 = $DIC{$1};
	} else {
	    $tel1 .= pack('C', hex($1));
	}
    }
    return ($flag1, $tel1);
}

sub hex2string
{
    $str = shift;
    my $ret = '';

    while ($str =~ s/^(..)//) {
	$ret .= pack('C', hex($1));
    }
    return $ret;
}

################################################################
### workhorse for put 
################################################################

sub put
{
    my @phoneBook = @_;
    my ($i, $num, $name, $yomi, $tel, $cmc);

    ## Clear 341S
    $ret = ATComm("AT#BC", "CAUSE");
    print STDERR "Phone Book Cleared.\n";

    for ($i = 0; $i <= $#phoneBook; $i++){
	printf STDERR "Sending %3d/%3d ...\n", $i+1, $#phoneBook+1;

	($num, $name, $yomi, $tel, $cmc) = @{$phoneBook[$i]};
	ATComm("AT#BW65535/03/$name/0", "CAUSE");
	ATComm("AT#BW65534/04/$yomi/0", "CAUSE");
	ATComm("AT#BW65534/05/$tel/0", "CAUSE");
	ATComm("AT#BW65534/06/$cmc/0", "CAUSE");
	ATComm("AT#BW65534/07/$num/1", "CAUSE");
    }
}

################################################################
### read user's phone book (put)
################################################################

sub readPhonebook
{
    my ($num, $name, $yomi, $tel1, $tel2, $cmc, $info, $tel, $str);
    my (@CURRENT_ENT, @phoneBook);

    while (<>){
	chomp;
	next if (!/^\s*\d/);
	s/^\s+//;  s/\s+$//;

	$str = '';
	while ($_){
	    if (s/^([\x81-\x9f\xe0-\xfc].|[\x00-\x7b\x7d-\x80\xa0-\xdf])+//){
		$str .= $&;
	    } elsif (s/^\x7c//) {
		$str .= "\x01";
	    } else {
		die "Phonebook has invalid character(s).\n";
	    }
	}

	($num, $name, $yomi, $tel1, $tel2, $cmc) = split(/\s*\x01\s*/, $str);

	if ($num =~ /^([123])(\+)?/){
	    ($num, $info) = ($1, $2);
	} else {
	    die "Wrong category number $num\n";
	}

	$num  = packNum($num);
	$tel  = packTel($tel1, $tel2, $info);
	$cmc  = packCMC($cmc);
	$name = packNam($name);
	$yomi = packYom($yomi);

	$CURRENT_ENT[$num]++;

	if ($CURRENT_ENT[$num] > $MAX_ENT[$num]){
	    $ret = ATComm('AT#BM1', 'OK');  close(SERIAL);
	    die "Book$num too large ($CURRENT_ENT[$num]>$MAX_ENT[$num]).\n";
	}
	push(@phoneBook, [$num, $name, $yomi, $tel, $cmc]);
    }
    return @phoneBook;
}

################################################################
### pack data for 341S (put)
################################################################
sub packNum
{
    my $num = shift;

    die "Number ($num) should be 1 or 2 or 3.\n" if ($num !~ /^[123]$/);
    return sprintf("%02X", $num);
}

sub packNam
{
    my $name = shift;

    die "Name ($name) is larger than 12.\n" if (length($name) > 12);
    return string2hex($name);
}

sub packYom
{
    my $yomi = shift;

    die "Yomi ($yomi) is larger than 4.\n" if (length($yomi) > 4);
    return string2hex($yomi);
}

sub packTel
{
    my ($tel1, $tel2, $info) = @_;
    my ($f1, $f2);
    my %DIC = ('s', "\x80",    'g', "\x81",     'x', "\x82",
	       '', "\x83",    '', "\x84",  );

    ($f1, $tel1) = split(':', $tel1) if ($tel1 =~ /:/);
    ($f2, $tel2) = split(':', $tel2) if ($tel2 =~ /:/);

    die "Invalid char in tel1 ($tel1).\n" if ($tel1 =~ /[^0-9\#\*PR]/);
    die "Invalid char in tel2 ($tel1).\n" if ($tel2 =~ /[^0-9\#\*PR]/);

    die "Invalid flag in tel1 ($f1).\n" if ($f1 ne '' && !defined $DIC{$f1});
    die "Invalid flag in tel2 ($f2).\n" if ($f2 ne '' && !defined $DIC{$f2});

    $tel1 =~ tr [R] [\x1c] ;
    $tel2 =~ tr [R] [\x1c] ;

    return '03' . 
	string2hex($DIC{$f1} . ($info eq '+' ? "\x90" : '') . $tel1) . 
	string2hex($DIC{$f2} . $tel2);
}

sub packCMC
{
    my $cmc = shift;
    my $area;
    my %DIC = (
	       'B',  "\x92",   'l',  "\x93",   
	       '',  "\x94",   '֐',  "\x95",   
	       'k',  "\x96",   'C',  "\x97",   
	       '',  "\x98",   'k',  "\x99",   
	       'kC',  "\x9A",   
	      );

    ($area, $cmc) = split(':', $cmc) if ($cmc =~ /:/);

    die "Invalid char in CMC ($cmc).\n"  if ($cmc =~ /[^0-9\#PR]/);
    die "Invalid area in CMC ($area).\n"
	if ($area ne '' && !defined $DIC{$area});
    
    return string2hex($DIC{$area} . $cmc);
}

sub string2hex
{
    my $str = shift;
    my $hex;

    if ($str eq ''){
	return '00';
    } else {
	$hex = unpack('H*', $str);
	$hex =~ tr/a-f/A-F/;
    }
    return sprintf("%02X", length($str)) . $hex;
}

################################################################
### serial handling (get, put)
################################################################

sub ATOpen
{
    my $dev = shift;
    my ($ret, $num, $max);

    open(SERIAL, "+>$dev") || die "ATOpen: Can't open $dev\n";
    select(SERIAL); $| = 1; select(STDOUT);

    $ret = ATComm('AT', 'OK');
    $ret = ATComm('AT', 'OK');
    $ret = ATComm('AT#BM1', 'OK');
    $ret = ATComm('AT#BM0', 'CAUSE');

    if ($ret =~ /TELBOOK=(\d+)\/(\d+)/){
	$num = $1;
    } else {
	ATClose();
	die "ATOpen: Communication Error Occured.\n";
    }
    return ($num, $max);
}

sub ATClose
{
    $ret = ATComm("AT#BM1", "OK");
    close(SERIAL);
}

sub ATComm
{
    my $str    = shift;
    my $expect = shift;
    my ($ret, $c);

    print STDERR "SEND $str\n" if $DEBUG;

    $str .= "\x0d\x0a";
    while ($str =~ s/(.)//){
	print SERIAL $1;
        read(SERIAL, $c, 1);
    }
    while (<SERIAL>){
	s/[\x0d\x0a]+$//;

	print STDERR "RETURN: $_\n" if $DEBUG;
	$ret .= " $_";

	last if /^$expect/;
    }
    return $ret;
}

################################################################
### EOF
################################################################
