view release on metacpan or  search on metacpan

lib/Alvis/Tana.pm  view on Meta::CPAN

my $debug = 0;

######################################################################
#
#  Public methods
#
###################################################################

sub error($)
{
    my ($client) = @_;
    return $ERROR{$client};
}

sub readname($)
{
    my ($client) = @_;

    my $len = readnum($client);
    if(!defined($len))
    {
	return undef;
    }

    my ($name,$got) = readbytes($client, $len);
    if(!defined($name))
    {
	return undef;
    }
    
    return $name;
}

sub readnum($)
{
    my ($client) = @_;

    my $got = 0;
    my $num = '';
    my $char = '0';

    while($char =~ /[0-9]/)
    {
	my $bytes = CORE::sysread($client, $char, 1);
	if($bytes != 1)
	{
	    $ERROR{$client} = "Readnum error: $@";
	    !$debug || print STDERR "readnum: $ERROR{$client}\n";
	    return undef;
	}

	if($char =~ /[0-9]/)
	{
	    $num .= $char;
	    $got++;
	}
    }

    if($char =~ /[^\n ]/)
    {
	$ERROR{$client} = "Non-eol/space at end of number. Got '$char' instead.";
	!$debug || print STDERR "readnum: $ERROR{$client}\n";
	return undef;
    }
    if(0 == $got)
    {
	$ERROR{$client} = "No numbers in readnum, got '$char' instead.";
	!$debug || print STDERR "readnum: $ERROR{$client}\n";
	return undef;	
    }

#    warn "Alvis::Tana::readnum() read num $num";
    
    return $num;
}

sub readbytes($$)
{
    my ($client, $len) = @_;

    my $str = '';


    my $got = CORE::sysread($client, $str, $len);
#    if($len != $got)
#    {
#	warn "Alvis::Tana::readbytes(): Wanted $len bytes, got $got";
#	$ERROR{$client} = "Wanted $len bytes, got $got";
#	!$debug || print STDERR "readnum: $ERROR{$client}\n";
#	return undef;
#    }

#    warn "Alvis::Tana::readbytes(): read $str";
    
    return ($str,$got);
}

sub read_field_header($)
{
    my ($client) = @_;

    my $keylen = readnum($client);
    if(!defined($keylen))
    {
	!$debug || print STDERR "read: $ERROR{$client}\n";
	return (undef, undef);
    }
    !$debug || print "keylen = *$keylen*\n";
    
    my ($key,$got) = readbytes($client, $keylen);
    if(!defined($key))
    {
	!$debug || print STDERR "read: $ERROR{$client}\n";
	return (undef, undef);
    }
    !$debug || print "key = $key\n";
    
    my $dummy;
    ($dummy,$got)=readbytes($client, 2);
    if(!defined($dummy))
    {