[freenet-cvs] r13618 - in trunk/apps/perlFreenet: . Freenet
alexlehm at freenetproject.org
alexlehm at freenetproject.org
Fri Jun 15 22:25:20 UTC 2007
Author: alexlehm
Date: 2007-06-15 22:25:20 +0000 (Fri, 15 Jun 2007)
New Revision: 13618
Modified:
trunk/apps/perlFreenet/
trunk/apps/perlFreenet/Freenet/
trunk/apps/perlFreenet/Freenet/Connection.pm
trunk/apps/perlFreenet/Freenet/Message.pm
trunk/apps/perlFreenet/README
trunk/apps/perlFreenet/perlfn.pl
trunk/apps/perlFreenet/putcomplexdir.pl
Log:
changed messages to support nested hashes, changed examples to use this feature
Property changes on: trunk/apps/perlFreenet
___________________________________________________________________
Name: svn:ignore
+ *.bak
Property changes on: trunk/apps/perlFreenet/Freenet
___________________________________________________________________
Name: svn:ignore
+ *.bak
Modified: trunk/apps/perlFreenet/Freenet/Connection.pm
===================================================================
--- trunk/apps/perlFreenet/Freenet/Connection.pm 2007-06-15 22:09:04 UTC (rev 13617)
+++ trunk/apps/perlFreenet/Freenet/Connection.pm 2007-06-15 22:25:20 UTC (rev 13618)
@@ -1,7 +1,7 @@
package Freenet::Connection;
use Freenet::Message;
-use IO::socket::INET;
+use IO::Socket::INET;
sub new {
my $class = shift;
@@ -122,7 +122,18 @@
last if /^EndMessage$/;
last if /^Data$/;
my($k,$v)=split(/=/,$_,2);
- $headers->{$k}=$v;
+ # handle keyword.keyword
+ if($k=~/^([^.]+)\.(.+)$/) {
+ my($ref)=\%{$headers->{$1}};
+ my($subkey)=$2;
+ while($subkey=~/^([^.]+)\.(.+)$/) {
+ $ref=\%{$ref->{$1}};
+ $subkey=$2;
+ }
+ $ref->{$subkey}=$v;
+ } else {
+ $headers->{$k}=$v;
+ }
}
if(/^Data$/) {
@@ -164,8 +175,7 @@
foreach my $k (keys(%{$msg->header})) {
my($h)=$msg->header($k);
- print $sock "$k=$h\n";
- $self->debug && print ">$k=$h\n";
+ $self->print_msghash($k, $h);
}
print $sock "EndMessage\n";
@@ -180,6 +190,33 @@
return 1;
}
+sub print_msghash
+{
+ my($self)=shift;
+ my($key)=shift;
+ my($value)=shift;
+ my($sock)=$self->{socket};
+
+ if(ref($value)) {
+ if(ref($value) eq "ARRAY") {
+ for(my $i=0;$i<int(@$value);$i++) {
+ $self->print_msghash("$key.$i",$value->[$i]);
+ }
+ }
+ elsif(ref($value) eq "HASH") {
+ foreach my $k (keys(%$value)) {
+ $self->print_msghash("$key.$k",$value->{$k});
+ }
+ }
+ else {
+ warn "unsupported value type ".ref($value)."\n";
+ }
+ } else {
+ print $sock "$key=$value\n";
+ $self->debug && print ">$key=$value\n";
+ }
+}
+
sub disconnect
{
my $self=shift;
Modified: trunk/apps/perlFreenet/Freenet/Message.pm
===================================================================
--- trunk/apps/perlFreenet/Freenet/Message.pm 2007-06-15 22:09:04 UTC (rev 13617)
+++ trunk/apps/perlFreenet/Freenet/Message.pm 2007-06-15 22:25:20 UTC (rev 13618)
@@ -39,13 +39,27 @@
if(int(@_)==0) {
return $self->{header};
} else {
- my $k=shift;
- return $self->{header}->{$k};
+ my @keys;
+ if(int(@_)>1) {
+ @keys=@_;
+ } else {
+ my $key=shift;
+ @keys=split(/\./,$key);
+ }
+ my $ref=$self->{header};
+ foreach my $k (@keys) {
+ $ref=$ref->{$k};
+ if(!defined($ref)) {
+ return undef;
+ }
+ }
+ return $ref;
}
}
# as_string is useful for debugging, returns the complete message ending
# with either EndMessage or Data
+# TODO: this duplicates code from Freenet::Connection
sub as_string
{
@@ -53,7 +67,7 @@
my($s)=$self->message."\n";
foreach my $k (keys(%{$self->header})) {
- $s.=$k."=".$self->header($k)."\n";
+ $s.=$self->string_msghash($k, $self->header->{$k});;
}
if(defined($self->data)) {
# ignore the data field for now
@@ -64,4 +78,32 @@
return $s;
}
+sub string_msghash
+{
+ my($self)=shift;
+ my($key)=shift;
+ my($value)=shift;
+
+ my($res)="";
+
+ if(ref($value)) {
+ if(ref($value) eq "ARRAY") {
+ for(my $i=0;$i<int(@$value);$i++) {
+ $res.=$self->string_msghash("$key.$i",$value->[$i]);
+ }
+ }
+ elsif(ref($value) eq "HASH") {
+ foreach my $k (keys(%$value)) {
+ $res.=$self->string_msghash("$key.$k",$value->{$k});
+ }
+ }
+ else {
+ warn "unsupported value type ".ref($value)."\n";
+ }
+ } else {
+ $res.="$key=$value\n";
+ }
+ return $res;
+}
+
1;
Modified: trunk/apps/perlFreenet/README
===================================================================
--- trunk/apps/perlFreenet/README 2007-06-15 22:09:04 UTC (rev 13617)
+++ trunk/apps/perlFreenet/README 2007-06-15 22:25:20 UTC (rev 13618)
@@ -12,9 +12,8 @@
There are quite a few things missing, e.g. Perldoc.
-Until now, I have used the library under Windows only (Vista and XP) with
-ActiveState Perl 5.8.8, it should work under Linux as well, but this is yet
-untested.
+I am developing the library under Windows only (Vista and XP) with ActiveState
+Perl 5.8.8, but it has been tested under Linux as well.
For feedback about the code, please use devel at P7LnnR2qMOTZdYbBa_teC92vTLQ in
[MAILBOX] or use the bug tracker at https://bugs.freenetproject.org/
Modified: trunk/apps/perlFreenet/perlfn.pl
===================================================================
--- trunk/apps/perlFreenet/perlfn.pl 2007-06-15 22:09:04 UTC (rev 13617)
+++ trunk/apps/perlFreenet/perlfn.pl 2007-06-15 22:25:20 UTC (rev 13618)
@@ -10,13 +10,18 @@
($nodehello=$node->connect) || warn "connect failed\n";
if($nodehello->message ne "NodeHello") {
- warn "something went wrong, got ".$nodehello->message." instead of NodeHello\n";
+ die "something went wrong, got ".$nodehello->message." instead of NodeHello\n";
}
# get uptime
$node->sendmessage("GetNode", {WithVolatile => 'true'});
$nodedata=$node->getmessage;
-$uptime=$nodedata->header("volatile.uptimeSeconds")/3600.0;
+# you can reference nested keywords either directly or by the parent hash:
+
+#$uptime=$nodedata->header("volatile.uptimeSeconds")/3600.0;
+$volatile=$nodedata->header("volatile");
+$uptime=$volatile->{"uptimeSeconds"}/3600.0;
+
print "uptime $uptime hours\n";
# get a list of peer node names
@@ -38,6 +43,8 @@
last if $msg->message eq "EndListPeers";
};
+exit;
+
$node->sendmessage("ClientGet",
{
IgnoreDS=>"false",
@@ -84,11 +91,6 @@
$node->sendmessage("GenerateSSK", {Identifier=>"My Identifier Blah Blah"});
print $node->getmessage->as_string;
-# shut down node (you probably dont want to do this is a test script)
-
-#$node->sendmessage("Shutdown");
-#print $node->getmessage->as_string;
-
# get CHK of a known file
# have to create the message beforehand since we have to add data element
@@ -111,7 +113,7 @@
}
);
-$data=read_file("c:/document.pdf", binmode => ':raw');
+$data=read_file("document.pdf", binmode => ':raw');
$msg->{data}=$data;
$msg->{header}->{DataLength}=length($data);
@@ -121,5 +123,10 @@
my($msg)=$node->getmessage;
print $msg->as_string;
+# shut down node (you probably dont want to do this is a test script)
+
+#$node->sendmessage("Shutdown");
+#print $node->getmessage->as_string;
+
$node->disconnect || warn "disconnect failed\n";
Modified: trunk/apps/perlFreenet/putcomplexdir.pl
===================================================================
--- trunk/apps/perlFreenet/putcomplexdir.pl 2007-06-15 22:09:04 UTC (rev 13617)
+++ trunk/apps/perlFreenet/putcomplexdir.pl 2007-06-15 22:25:20 UTC (rev 13618)
@@ -1,5 +1,7 @@
#! perl
+# test insert of a freesite, this expects a dummy site in testsite/*
+
use Data::Dumper;
use File::Slurp;
@@ -10,12 +12,12 @@
($nodehello=$node->connect) || warn "connect failed\n";
if($nodehello->message ne "NodeHello") {
- warn "something went wrong, got ".$nodehello->message." instead of NodeHello\n";
+ die "something went wrong, got ".$nodehello->message." instead of NodeHello\n";
}
-$file0=read_file("index.html");
-$file1=read_file("foo.zip", binmode=>':raw');
-$file2=read_file("doc.pdf", binmode=>':raw');
+$file0=read_file("testsite/index.html");
+$file1=read_file("testsite/foo.zip", binmode=>':raw');
+$file2=read_file("testsite/doc.pdf", binmode=>':raw');
$msg=Freenet::Message->new("ClientPutComplexDir",
{
@@ -24,24 +26,32 @@
MaxRetries=>999,
PriorityClass=>2,
URI=>'CHK@',
- GetCHKOnly=>"false",
+ GetCHKOnly=>"true",
DontCompress=>"false",
ClientToken=>"My Client Token",
Persistence=>"connection",
Global=>"false",
DefaultName=>"index.html",
- "Files.0.Name"=>"index.html",
- "Files.0.UploadFrom"=>"direct",
- "Files.0.Metadata.ContentType"=>"text/html",
- "Files.0.DataLength"=>length($file0),
- "Files.1.Name"=>"foo.zip",
- "Files.1.UploadFrom"=>"direct",
- "Files.1.Metadata.ContentType"=>"application/zip",
- "Files.1.DataLength"=>length($file1),
- "Files.2.Name"=>"doc.pdf",
- "Files.2.UploadFrom"=>"direct",
- "Files.2.Metadata.ContentType"=>"application/pdf",
- "Files.2.DataLength"=>length($file2),
+ Files => [
+ {
+ Name=>"index.html",
+ UploadFrom=>"direct",
+ "Metadata.ContentType"=>"text/html",
+ DataLength=>length($file0),
+ },
+ {
+ Name=>"foo.zip",
+ UploadFrom=>"direct",
+ "Metadata.ContentType"=>"application/zip",
+ DataLength=>length($file1),
+ },
+ {
+ Name=>"doc.pdf",
+ UploadFrom=>"direct",
+ "Metadata.ContentType"=>"application/pdf",
+ DataLength=>length($file2),
+ },
+ ]
}
);
@@ -51,5 +61,8 @@
while(1) {
my($msg)=$node->getmessage;
+ # TODO: should catch error messages as well
+ last if $msg->message eq "PutSuccessful";
}
+
$node->disconnect || warn "disconnect failed\n";
More information about the cvs
mailing list