i2p.itoopie/apps/sam/perl/Net/SAM.pm

#!/usr/bin/perl

## Copyright 2004 Brian Ristuccia. This program is Free Software;
## You can redistribute it and/or modify it under the same terms as
## Perl itself. 

package Net::SAM;

@ISA = ( "IO::Socket::INET" ); 

use strict;

use Switch;

use IO::Socket;
use IO::Select;

#use Net::SAM::StreamSession;
#use Net::SAM::DatagramSession;
#use Net::SAM::RawSession;

sub new {
    my ($class) = shift;
    my $type = ref($class) || $class;
    my $self = $type->SUPER::new("127.0.0.1:7656");


    ${*$self}->{incomingraw} = [];

    # Connect us to the local SAM proxy. 
    # my $samsock = IO::Socket::INET->new('127.0.0.1:7657');
    #$self->{samsock}=$samsock;

    # Say hello, read response. 
    $self->SUPER::send("HELLO VERSION MIN=1.0 MAX=1.0\n");
    
    while (! ${*$self}->{greeted}) { 
	$self->readprocess();
    }
    print "Created SAM object\n";
    return $self;
}

sub lookup {
    my $self = shift;
    my $name= shift;

    $self->SUPER::send("NAMING LOOKUP NAME=$name\n");
    undef ${*$self}->{RESULT};
    while (! ${*$self}->{RESULT}) {
	$self->readprocess();
    }
    if ( ${*$self}->{RESULT} == "OK" ) {
	return ${*$self}->{VALUE};
    } else {
	return undef;
    }
}

#sub createsession {
#    my ($self) = shift;
#    my ($sesstype) = shift;
#    print $self->{samsock} "SESSION CREATE STYLE=$SESSTYPE DESTINATION=$DEST, DIRECTION=
#}

#sub waitfor {
#    my ($self) = shift;
#    my ($prefix) = shift;
#    my ($response) = <$samsock>;#

 #   if $response =~ 
    

#}

sub readprocess {    
    my $self = shift;
    my $chunk;
    my $payload; 

    print "readprocess: " . $self->connected() . "\n";

    # May block if the SAM bridge gets hosed
    my $response = <$self>;

    print "readprocess: $!" . $self->connected() . "\n";

    chomp $response;
    my ($primative, $more, $extra) = split (' ', $response, 3);

    $primative = uc($primative);

    print "readprocess: " . $self->connected() . " -- $primative -- $more -- $extra\n";

    switch ($primative) {

	case "HELLO" {
	    if ($more !~ m/REPLY/ ) { die ("Bogus HELLO response") }
	    if ($extra =~ m/NOVERSION/ ) { 
		die("SAM Bridge Doesn't support my version") ;
	    }
	    $self->_hashtv($extra);
	    ${*$self}->{greeted} = 1;
	};
	case "SESSION" {
	    if ( $more !~ m/STATUS/ ) {
		die("Bogus SESSION response");
	    }
	    $self->_hashtv($extra);
	}
	case "STREAM" {};
	case "DATAGRAM" {
	    if ( $more !~ m/RECEIVE/ ) {
		die("Bogus DATAGRAM response.");
	    }
	    $self->_hashtv($extra);
	    push @{ ${*$self}->{incomingdatagram } }, 
		    [ ${*$self}->{DESTINATION},
		      $self->_readblock(${*$self}->{SIZE}) ];
		      
	};
	case "RAW" {
	    if ( $more !~ m/RECEIVE/ ) {
		die("Bogus RAW response.");
	    }
	    $self->_hashtv($extra);

	    push @{ $self->{incomingraw} }, $self->_readblock($self->{SIZE});
	};
	case "NAMING" {
	    if ( $more !~ m/REPLY/ ) {
		die("Bogus NAMING response");
	    }
	    $self->_hashtv($extra);
	};
	case "DEST" {};
    }
    return 1; 
}

sub getfh {
    # Return the FH of the SAM socket so apps can select() or poll() on it
    my $self = shift;
    return $self->{samsock};
}

sub _readblock {
    my $self = shift;
    my $size = shift; 
    my $chunk;
    my $payload;

    while ( $size > 1 )  {
	# XXX: May block. No error checking. 
	print "readblock: $size\n";
	$size -= $self->SUPER::recv($chunk, $size);
	$payload .= $chunk;
    }
    return $payload; 
}

sub _hashtv {
    my $self = shift;
    my $extra = shift;

    while ( $extra=~ m/(\S+)=(\S+)/sg ) {
	${*$self}->{$1}=$2;
	print "$1=$2\n"
    }
}

sub DESTROY {
    # Do nothing yet. 
}

#sub StreamSession {
#    my $self = shift;
#    return Net::SAM::StreamSession->new($self);
#}

#sub DatagramSession {
#    return Net::SAM::DatagramSession->new($self);
#}

#sub RawSession {
#    return Net::SAM::RawSession->new($self);
#}

1;