source: apps/sam/perl/Net/SAM.pm @ 6003b29

Last change on this file since 6003b29 was 6003b29, checked in by zzz <zzz@…>, 17 years ago

Preliminary checkin of (mostly useless) Net::SAM perl module.

Net::SAM::StreamSession? is currently unimplemented.
Net::Sam::[Datagram|Raw]Session block when they shouldn't and are buggy.

  • Property mode set to 100644
File size: 3.8 KB
Line 
1#!/usr/bin/perl
2
3## Copyright 2004 Brian Ristuccia. This program is Free Software;
4## You can redistribute it and/or modify it under the same terms as
5## Perl itself.
6
7package Net::SAM;
8
9@ISA = ( "IO::Socket::INET" ); 
10
11use strict;
12
13use Switch;
14
15use IO::Socket;
16use IO::Select;
17
18#use Net::SAM::StreamSession;
19#use Net::SAM::DatagramSession;
20#use Net::SAM::RawSession;
21
22sub new {
23    my ($class) = shift;
24    my $type = ref($class) || $class;
25    my $self = $type->SUPER::new("127.0.0.1:7656");
26
27
28    ${*$self}->{incomingraw} = [];
29
30    # Connect us to the local SAM proxy.
31    # my $samsock = IO::Socket::INET->new('127.0.0.1:7657');
32    #$self->{samsock}=$samsock;
33
34    # Say hello, read response.
35    $self->SUPER::send("HELLO VERSION MIN=1.0 MAX=1.0\n");
36   
37    while (! ${*$self}->{greeted}) { 
38        $self->readprocess();
39    }
40    print "Created SAM object\n";
41    return $self;
42}
43
44sub lookup {
45    my $self = shift;
46    my $name= shift;
47
48    $self->SUPER::send("NAMING LOOKUP NAME=$name\n");
49    undef ${*$self}->{RESULT};
50    while (! ${*$self}->{RESULT}) {
51        $self->readprocess();
52    }
53    if ( ${*$self}->{RESULT} == "OK" ) {
54        return ${*$self}->{VALUE};
55    } else {
56        return undef;
57    }
58}
59
60#sub createsession {
61#    my ($self) = shift;
62#    my ($sesstype) = shift;
63#    print $self->{samsock} "SESSION CREATE STYLE=$SESSTYPE DESTINATION=$DEST, DIRECTION=
64#}
65
66#sub waitfor {
67#    my ($self) = shift;
68#    my ($prefix) = shift;
69#    my ($response) = <$samsock>;#
70
71 #   if $response =~
72   
73
74#}
75
76sub readprocess {   
77    my $self = shift;
78    my $chunk;
79    my $payload; 
80
81    print "readprocess: " . $self->connected() . "\n";
82
83    # May block if the SAM bridge gets hosed
84    my $response = <$self>;
85
86    print "readprocess: $!" . $self->connected() . "\n";
87
88    chomp $response;
89    my ($primative, $more, $extra) = split (' ', $response, 3);
90
91    $primative = uc($primative);
92
93    print "readprocess: " . $self->connected() . " -- $primative -- $more -- $extra\n";
94
95    switch ($primative) {
96
97        case "HELLO" {
98            if ($more !~ m/REPLY/ ) { die ("Bogus HELLO response") }
99            if ($extra =~ m/NOVERSION/ ) { 
100                die("SAM Bridge Doesn't support my version") ;
101            }
102            $self->_hashtv($extra);
103            ${*$self}->{greeted} = 1;
104        };
105        case "SESSION" {
106            if ( $more !~ m/STATUS/ ) {
107                die("Bogus SESSION response");
108            }
109            $self->_hashtv($extra);
110        }
111        case "STREAM" {};
112        case "DATAGRAM" {
113            if ( $more !~ m/RECEIVE/ ) {
114                die("Bogus DATAGRAM response.");
115            }
116            $self->_hashtv($extra);
117            push @{ ${*$self}->{incomingdatagram } }, 
118                    [ ${*$self}->{DESTINATION},
119                      $self->_readblock(${*$self}->{SIZE}) ];
120                     
121        };
122        case "RAW" {
123            if ( $more !~ m/RECEIVE/ ) {
124                die("Bogus RAW response.");
125            }
126            $self->_hashtv($extra);
127
128            push @{ $self->{incomingraw} }, $self->_readblock($self->{SIZE});
129        };
130        case "NAMING" {
131            if ( $more !~ m/REPLY/ ) {
132                die("Bogus NAMING response");
133            }
134            $self->_hashtv($extra);
135        };
136        case "DEST" {};
137    }
138    return 1; 
139}
140
141sub getfh {
142    # Return the FH of the SAM socket so apps can select() or poll() on it
143    my $self = shift;
144    return $self->{samsock};
145}
146
147sub _readblock {
148    my $self = shift;
149    my $size = shift; 
150    my $chunk;
151    my $payload;
152
153    while ( $size > 1 )  {
154        # XXX: May block. No error checking.
155        print "readblock: $size\n";
156        $size -= $self->SUPER::recv($chunk, $size);
157        $payload .= $chunk;
158    }
159    return $payload; 
160}
161
162sub _hashtv {
163    my $self = shift;
164    my $extra = shift;
165
166    while ( $extra=~ m/(\S+)=(\S+)/sg ) {
167        ${*$self}->{$1}=$2;
168        print "$1=$2\n"
169    }
170}
171
172sub DESTROY {
173    # Do nothing yet.
174}
175
176#sub StreamSession {
177#    my $self = shift;
178#    return Net::SAM::StreamSession->new($self);
179#}
180
181#sub DatagramSession {
182#    return Net::SAM::DatagramSession->new($self);
183#}
184
185#sub RawSession {
186#    return Net::SAM::RawSession->new($self);
187#}
188
1891;
Note: See TracBrowser for help on using the repository browser.