ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-FCP/FCP.pm
(Generate patch)

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.1 by root, Sun Sep 7 22:57:40 2003 UTC vs.
Revision 1.2 by root, Sun Sep 7 23:20:20 2003 UTC

… …
59 59
60$regcb = \&event_reg_cb; 60$regcb = \&event_reg_cb;
61$unregcb = \&event_unreg_cb; 61$unregcb = \&event_unreg_cb;
62$waitcb = \&event_wait_cb; 62$waitcb = \&event_wait_cb;
63 63
64sub touc($) {
65 local $_ = shift;
66 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/;
67 s/(?:^|_)(.)/\U$1/g;
68 $_;
69}
70
71sub tolc($) {
72 local $_ = shift;
73 s/(?<=[a-z])(?=[A-Z])/_/g;
74 lc $_;
75}
76
64=item $fcp = new Net::FCP [host => $host][, port => $port] 77=item $fcp = new Net::FCP [host => $host][, port => $port]
65 78
66Create a new virtual FCP connection to the given host and port (default 79Create a new virtual FCP connection to the given host and port (default
67127.0.0.1:8481). 80127.0.0.1:8481).
68 81
… …
92=cut 105=cut
93 106
94sub txn { 107sub txn {
95 my ($self, $type, %attr) = @_; 108 my ($self, $type, %attr) = @_;
96 109
110 $type = touc $type;
111
97 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $type, attr => \%attr); 112 my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);
98 113
99 $txn; 114 $txn;
100} 115}
101 116
102sub _txn($&) { 117sub _txn($&) {
… …
110=item $nodehello = $fcp->client_hello 125=item $nodehello = $fcp->client_hello
111 126
112Executes a ClientHello request and returns it's results. 127Executes a ClientHello request and returns it's results.
113 128
114 { 129 {
115 MaxFileSize => "5f5e100", 130 max_file_size => "5f5e100",
116 Protocol => "1.2", 131 protocol => "1.2",
117 Node => "Fred,0.6,1.46,7050" 132 node => "Fred,0.6,1.46,7050"
118 } 133 }
119 134
120=cut 135=cut
121 136
122_txn client_hello => sub { 137_txn client_hello => sub {
123 my ($self) = @_; 138 my ($self) = @_;
124 139
125 $self->txn ("ClientHello"); 140 $self->txn ("client_hello");
126}; 141};
127 142
128=item $txn = $fcp->txn_client_info 143=item $txn = $fcp->txn_client_info
129 144
130=item $nodeinfo = $fcp->client_info 145=item $nodeinfo = $fcp->client_info
131 146
132Executes a ClientInfo request and returns it's results. 147Executes a ClientInfo request and returns it's results.
133 148
134 { 149 {
135 MaxFileSize => "5f5e100", 150 max_file_size => "5f5e100",
136 DatastoreMax => "2540be400", 151 datastore_max => "2540be400",
137 NodePort => 369, 152 node_port => 369,
138 JavaName => "Java HotSpot(TM) Server VM", 153 java_name => "Java HotSpot(_T_M) Server VM",
139 OperatingSystemVersion => "2.4.20", 154 operating_system_version => "2.4.20",
140 EstimatedLoad => 52, 155 estimated_load => 52,
141 FreeMemory => "5cc0148", 156 free_memory => "5cc0148",
142 DatastoreFree => "5ce03400", 157 datastore_free => "5ce03400",
143 NodeAddress => "1.2.3.4", 158 node_address => "1.2.3.4",
144 ActiveJobs => "1f", 159 active_jobs => "1f",
145 AllocatedMemory => "bde0000", 160 allocated_memory => "bde0000",
146 Architecture => "i386", 161 architecture => "i386",
147 RoutingTime => "a5", 162 routing_time => "a5",
148 LeastRecentTimestamp => "f41538b878", 163 least_recent_timestamp => "f41538b878",
149 AvailableThreads => 17, 164 available_threads => 17,
150 DatastoreUsed => "1f72bb000", 165 datastore_used => "1f72bb000",
151 JavaVersion => "Blackdown-1.4.1-01", 166 java_version => "Blackdown-1.4.1-01",
152 IsTransient => "false", 167 is_transient => "false",
153 OperatingSystem => "Linux", 168 operating_system => "Linux",
154 JavaVendor => "http://www.blackdown.org/", 169 java_vendor => "http://www.blackdown.org/",
155 MostRecentTimestamp => "f77e2cc520" 170 most_recent_timestamp => "f77e2cc520"
156 } 171 }
157 172
158=cut 173=cut
159 174
160_txn client_info => sub { 175_txn client_info => sub {
161 my ($self) = @_; 176 my ($self) = @_;
162 177
163 $self->txn ("ClientInfo"); 178 $self->txn ("client_info");
164}; 179};
165 180
166=item $txn = $fcp->txn_generate_chk ($metadata, $data) 181=item $txn = $fcp->txn_generate_chk ($metadata, $data)
167 182
168=item $uri = $fcp->generate_chk ($metadata, $data) 183=item $uri = $fcp->generate_chk ($metadata, $data)
… …
172=cut 187=cut
173 188
174_txn generate_chk => sub { 189_txn generate_chk => sub {
175 my ($self, $metadata, $data) = @_; 190 my ($self, $metadata, $data) = @_;
176 191
177 $self->txn (GenerateCHK => data => "$data$metadata", MetaDataLength => length $metadata); 192 $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);
178}; 193};
179 194
180=item $txn = $fcp->txn_generate_svk_pair 195=item $txn = $fcp->txn_generate_svk_pair
181 196
182=item ($public, $private) = @{ $fcp->generate_svk_pair } 197=item ($public, $private) = @{ $fcp->generate_svk_pair }
… …
191=cut 206=cut
192 207
193_txn generate_svk_pair => sub { 208_txn generate_svk_pair => sub {
194 my ($self) = @_; 209 my ($self) = @_;
195 210
196 $self->txn ("GenerateSVKPair"); 211 $self->txn ("generate_svk_pair");
197}; 212};
198 213
199=item $txn = $fcp->txn_insert_private_key ($private) 214=item $txn = $fcp->txn_insert_private_key ($private)
200 215
201=item $uri = $fcp->insert_private_key ($private) 216=item $uri = $fcp->insert_private_key ($private)
… …
211=cut 226=cut
212 227
213_txn insert_private_key => sub { 228_txn insert_private_key => sub {
214 my ($self, $privkey) = @_; 229 my ($self, $privkey) = @_;
215 230
216 $self->txn (InvertPrivateKey => Private => $privkey); 231 $self->txn (invert_private_key => private => $privkey);
217}; 232};
218 233
219=item $txn = $fcp->txn_get_size ($uri) 234=item $txn = $fcp->txn_get_size ($uri)
220 235
221=item $length = $fcp->get_size ($uri) 236=item $length = $fcp->get_size ($uri)
… …
228=cut 243=cut
229 244
230_txn get_size => sub { 245_txn get_size => sub {
231 my ($self, $uri) = @_; 246 my ($self, $uri) = @_;
232 247
233 $self->txn (GetSize => URI => $uri); 248 $self->txn (get_size => URI => $uri);
234}; 249};
235 250
236=item MISSING: ClientGet, ClientPut 251=item MISSING: ClientGet, ClientPut
237 252
238=back 253=back
… …
266 281
267 my $attr = ""; 282 my $attr = "";
268 my $data = delete $self->{attr}{data}; 283 my $data = delete $self->{attr}{data};
269 284
270 while (my ($k, $v) = each %{$self->{attr}}) { 285 while (my ($k, $v) = each %{$self->{attr}}) {
271 $attr .= "$k=$v\012" 286 $attr .= (Net::FCP::touc $k) . "=$v\012"
272 } 287 }
273 288
274 if (defined $data) { 289 if (defined $data) {
275 $attr .= "DataLength=" . (length $data) . "\012"; 290 $attr .= "DataLength=" . (length $data) . "\012";
276 $data = "Data\012$data"; 291 $data = "Data\012$data";
… …
283 PeerPort => $self->{fcp}{port} 298 PeerPort => $self->{fcp}{port}
284 or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; 299 or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
285 300
286 binmode $fh, ":raw"; 301 binmode $fh, ":raw";
287 302
303 if (0) {
288 print 304 print
289 $self->{type}, "\012", 305 Net::FCP::touc $self->{type}, "\012",
290 $attr, 306 $attr,
291 $data, "\012"; 307 $data, "\012";
308 }
292 309
293 print $fh 310 print $fh
294 "\x00\x00", "\x00\x02", # SESSID, PRESID 311 "\x00\x00", "\x00\x02", # SESSID, PRESID
295 $self->{type}, "\012", 312 Net::FCP::touc $self->{type}, "\012",
296 $attr, 313 $attr,
297 $data; 314 $data;
298 315
299 #$fh->shutdown (1); # freenet buggy?, well, it's java... 316 #$fh->shutdown (1); # freenet buggy?, well, it's java...
300 317
… …
317 last; 334 last;
318 } 335 }
319 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { 336 } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) {
320 $self->{datalen} = $1; 337 $self->{datalen} = $1;
321 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { 338 } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {
322 $self->rcv ($1, {map { split /=/, $_, 2 } split /\015?\012/, $2}); 339 $self->rcv ($1, {
340 map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
341 split /\015?\012/, $2
342 });
323 } else { 343 } else {
324 last; 344 last;
325 } 345 }
326 } 346 }
327 } else { 347 } else {
… …
335 my ($self, $chunk) = @_; 355 my ($self, $chunk) = @_;
336} 356}
337 357
338sub rcv { 358sub rcv {
339 my ($self, $type, $attr) = @_; 359 my ($self, $type, $attr) = @_;
340 #use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr);
341 360
361 $type = Net::FCP::tolc $type;
362
342 if (my $method = $self->can("rcv_\L$type")) { 363 if (my $method = $self->can("rcv_$type")) {
343 $method->($self, $attr, $type); 364 $method->($self, $attr, $type);
344 } else { 365 } else {
345 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; 366 warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
346 $self->eof; 367 $self->eof;
347 } 368 }
… …
376 397
377package Net::FCP::Txn::ClientHello; 398package Net::FCP::Txn::ClientHello;
378 399
379use base Net::FCP::Txn; 400use base Net::FCP::Txn;
380 401
381sub rcv_nodehello { 402sub rcv_node_hello {
382 my ($self, $attr) = @_; 403 my ($self, $attr) = @_;
383 404
384 $self->eof ($attr); 405 $self->eof ($attr);
385} 406}
386 407
387package Net::FCP::Txn::ClientInfo; 408package Net::FCP::Txn::ClientInfo;
388 409
389use base Net::FCP::Txn; 410use base Net::FCP::Txn;
390 411
391sub rcv_nodeinfo { 412sub rcv_node_info {
392 my ($self, $attr) = @_; 413 my ($self, $attr) = @_;
393 414
394 $self->eof ($attr); 415 $self->eof ($attr);
395} 416}
396 417

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines