package Net::ZWrite;

# Original author possibly Marc Horowitz <marc@mit.edu>
# Packaged for Perl 5 by Reid Barton <rwbarton@numenor.mit.edu>

# We don't support @zhmaddr any more.

use strict;
use warnings;
use Carp;

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    
    $VERSION = 1.00;

    @ISA = qw(Exporter);
    @EXPORT = qw(&zwrite);
    %EXPORT_TAGS = ();
}

use IO::Socket::INET;

my $uidinc = 0;
my $oldtime = -1;

my $localaddr;

sub zascii {
    my ($retval,$data) = ("",$_[0]);
    my ($c1,$c2,$c3,$c4);
    while (length($data)>=4) {
	$retval .= " " if ($retval);
	($c1,$c2,$c3,$c4,$data) = unpack("C4a*",$data);
	$retval .= sprintf("0x%02X%02X%02X%02X",$c1,$c2,$c3,$c4);
    }

    if ($data) {
	$retval .= " " if ($retval);
	$retval .= "0x";
	while ($data) {
	    ($c1,$data) = unpack("Ca*",$data);
	    $retval .= sprintf("%02X",$c1);
	}
    }

    return($retval);
}

sub zlong {
    return(&zascii(pack("N",$_[0]))."\0");
}

sub thechop {
    my ($foo) = $_[0];
    chop($foo);
    return($foo);
}

sub zpacket {
    my ($uid, $class, $inst, $opcode, $sender, $recip, $default, $msg)
	= @_;
    my ($packet);

    if (! $uid) {
	$localaddr = ((gethostbyname(&thechop(`hostname`)))[4])
	    if (! $localaddr);
	$uidinc = 0 if ($oldtime != time);
	$uidinc++;
	$uid = pack("a4 N N",$localaddr,$oldtime=time,$uidinc);
    }

    $packet .= "ZEPH0.2\0";
    $packet .= &zlong(17);
    $packet .= &zlong(0);	# UNSAFE
    $packet .= &zascii($uid)."\0";
    $packet .= &zascii(pack("n",0))."\0"; # no response port
    $packet .= &zlong(0);	# no auth
    $packet .= &zlong(0);	# authlen = 0
    $packet .= "\0";		# no authdata
    $packet .= $class."\0";
    $packet .= $inst."\0";
    $packet .= $opcode."\0";
    $packet .= $sender."\0";
    $packet .= $recip."\0";
    $packet .= $default."\0";
    $packet .= &zlong(0);	# no checksum
    $packet .= "\0";		# no fragmentation
    $packet .= &zascii($uid)."\0";
    $packet .= $msg;

    return $packet;
}

sub zwrite {
    my %values = (
		  uid => 0,
		  class => "",
		  instance => "",
		  opcode => "",
		  sender => "",
		  recipient => "",
		  default => "Class \$class, Instance \$instance:\n"
		  . "To \@bold(\$recipient) at \$time \$date\n"
		  . "From \@bold{\$1 <\$sender>}\n\n"
		  . "\$2",
		  msg => "",
		  @_		# Override defaults with whatever values were passed in
		  );

		  
    my $port = (getservbyname("zephyr-hm", "udp"))[2];
    my $socket = IO::Socket::INET->new(PeerAddr => "127.0.0.1:$port",
				       LocalAddr => '127.0.0.1:0',
				       Proto => 'udp')
	|| confess "$! creating socket";
    my $packet = &zpacket(@values{qw(uid class instance opcode sender recipient default msg)});
    $socket->send($packet, 0)
	|| confess "$! sending packet";
}

1;
