view release on metacpan or  search on metacpan

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

	my ($keylen, $key) = read_field_header($client);

	if(!defined($keylen))
	{
	    return undef;
	}

	!$debug || print STDERR "Alvis::Tana::read() set autoread_arb to -$key-\n";
	$$autoread_arb = $key;
    }
    elsif(defined($autoread_arb))
    {
	$$autoread_arb = undef;
    }

    return $msg;
}

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

    my $str = '';

    $$eof = 0;

    while($len > 0)
    {
	my $char;
	my $got = CORE::sysread($client, $char, 1);

	if(1 != $got)
	{
	    $ERROR{$client} = "Wanted 1 bytes, got $got";
	    !$debug || print STDERR "read_arb: $ERROR{$client}\n";
	    return undef;
	}

	!$debug || print STDERR "Read arb '$char'\n";
	if($char eq "\\")
	{
	    $got = CORE::sysread($client, $char, 1);
	    if(1 != $got)
	    {
		$ERROR{$client} = "Wanted 1 bytes, got $got";
	    !$debug || print STDERR "read_arb: $ERROR{$client}\n";
		return undef;
	    }

	    !$debug || print STDERR "Read arb '$char'\n";
	    if($char eq 'n')
	    {
		$str .= "\n";
	    }
	    elsif($char eq "\\")
	    {
		$str .= "\\";
	    }
	    else
	    {
		$ERROR{$client} = "Invalid escaped char '$char' after '\\'";
		!$debug || print STDERR "read_arb: $ERROR{$client}\n";
		return undef;
	    }
	}
	elsif($char eq "\n")
	{
	    $$eof = 1;
	    last;
	}
	else
	{
	    $str .= $char;
	}

	$len--;
    }

    return $str;
}


sub write_arb($$$)
{
    my ($client, $str, $final) = @_;

    while(length($str) > 0)
    {
	$str =~ s/(.)(.*)/$2/s;
	!$debug || print STDERR "Sending arb '$1'\n";
	if($1 eq "\\")
	{
	    my $out = "\\\\";
	    if(length($out) != CORE::syswrite($client, $out, length($out)))
	    {
		$ERROR{$client} = "write to socket failed: $@";
		return 0;
	    }
	}
        elsif($1 eq "\n")
        {
	    my $out = "\\n";
	    if(length($out) != CORE::syswrite($client, $out, length($out)))
	    {
		$ERROR{$client} = "write to socket failed: $@";
		return 0;
	    }
	}
	else
	{
	    my $out = $1;
	    if(length($out) != CORE::syswrite($client, $out, length($out)))
	    {
		$ERROR{$client} = "write to socket failed: $@";
		return 0;
	    }
	}
    }

    if($final)
    {