[Bio] / Sprout / ERDBClient.pm Repository:
ViewVC logotype

Annotation of /Sprout/ERDBClient.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : olson 1.1 package ERDBClient;
2 :    
3 :     use strict;
4 :     use FreezeThaw qw(thaw);
5 :     use LWP::UserAgent;
6 :     use LWP::Protocol;
7 :     use HTTP::Request::Common;
8 :     use base 'Class::Accessor';
9 :     use Data::Dumper;
10 :    
11 :     require LWP::Protocol::http10;
12 :     LWP::Protocol::implementor('http', 'LWP::Protocol::http10');
13 :    
14 :     my $CRLF = "\015\012"; # how lines should be terminated;
15 :     # "\r\n" is not correct on all systems, for
16 :     # instance MacPerl defines it to "\012\015"
17 :    
18 :     __PACKAGE__->mk_accessors(qw(ua server_url database));
19 :    
20 :     sub new
21 :     {
22 :     my($class, $server_url, $database) = @_;
23 :    
24 :     if ($server_url !~ /cgi$/)
25 :     {
26 :     $server_url .= "/ERDBServer.cgi";
27 :     }
28 :     my $ua = LWP::UserAgent->new();
29 :    
30 :     my $self = {
31 :     server_url => $server_url,
32 :     database => $database,
33 :     ua => $ua,
34 :     };
35 :    
36 :     return bless $self, $class;
37 :     }
38 :    
39 :     #
40 :     # We assemble the request manually using the methods that LWP::UserAgent does
41 :     # because we want to incrementally pull the response from the socket.
42 :     #
43 :    
44 :     sub Get
45 :     {
46 :     my($self, $objectNames, $filterClause, $params, $fields, $count) = @_;
47 :    
48 :     my @params = (db => $self->database,
49 :     op => 'Get',
50 :     path => $objectNames,
51 :     filter => $filterClause,
52 :     @$params ? map { (params => $_) } @$params : (),
53 :     @$fields ? map { (fields => $_) } @$fields : (),
54 :     count => $count,
55 :     );
56 :     # print Dumper(\@params);
57 :    
58 :     my $req = POST $self->server_url, \@params;
59 :    
60 :     my $method = $req->method;
61 :     my $url = $req->url;
62 :     my $host = $url->host;
63 :     my $port = $url->port;
64 :     my $fullpath = $url->path_query;
65 :     $fullpath = "/$fullpath" unless $fullpath =~ m,^/,;
66 :     my $timeout = 180;
67 :    
68 :     my $proto = LWP::Protocol::create('http', $self);
69 :     my $socket = $proto->_new_socket($host, $port, $timeout);
70 :     $socket->blocking(1);
71 :     my $request_headers = $req->headers->clone;
72 :     $proto->_fixup_header($request_headers, $url, undef);
73 :     my @h;
74 :     $request_headers->scan(sub {
75 :     my($k, $v) = @_;
76 :     $k =~ s/^://;
77 :     $v =~ s/\n/ /g;
78 :     push(@h, $k, $v);
79 :     });
80 :     push(@h, TE => '');
81 :    
82 :     print Dumper(\@h);
83 :     my $req_buf = "$method $fullpath HTTP/1.0$CRLF";
84 :     $req_buf .= $request_headers->as_string($CRLF) . $CRLF;
85 :    
86 :     my $tmp = $req_buf;
87 :     $tmp =~ s/\r/\\r/g;
88 :     print "req: $tmp\n";
89 :    
90 :     my $n = $socket->syswrite($req_buf, length($req_buf));
91 :     print "Wrote $n\n";
92 :     die $! unless defined($n);
93 :     die "short write" unless $n == length($req_buf);
94 :    
95 :     $req_buf = $req->content;
96 :     print $req_buf;
97 : parrello 1.2 $n = $socket->syswrite($req_buf, length($req_buf));
98 : olson 1.1 print "Wrote $n\n";
99 :     die $! unless defined($n);
100 :     die "short write" unless $n == length($req_buf);
101 :    
102 :     while (<$socket>)
103 :     {
104 :     last if /^\s*$/;
105 :     s/\r/\\r/g;
106 :     print "Hdr: $_";
107 :     }
108 :    
109 :     print "Hdrs done\n";
110 :    
111 :     while (!$socket->eof())
112 :     {
113 :     my $len = <$socket>;
114 :     if ($len =~ /(\d+)/)
115 :     {
116 :     my $buf;
117 :     my $n = $socket->read($buf, $len);
118 :     print "Read $n: '$buf'\n";
119 :     my @dat = thaw($buf);
120 :     print Dumper(\@dat);
121 :     }
122 :    
123 :     }
124 :     }
125 :    
126 :    
127 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3