package Net::Distributed; =head1 NAME Net::Distributed =head1 SYNOPSIS use Net::Distributed; use Net::Distributed::Handler::Joiner; my $peer = new Net::Distributed ( address => 'www.my-elite-mp3-server.com:9009', services => [':Joiner'] ); $peer->send_join_request( address => 'www.my-mates-mp3-server.com:6789', ); $peer->run; =head1 DESCRIPTION Net::Distributed provides services for building distributed computing or peer-to-peer networks with Perl. It aims to be flexible enough to c +ope with different (e.g. cross-language) message formats and transports, but provides Perl-specific defaults. Net::Distributed provides the following services: =over 4 =item Address book An addressbook to store information about peers, with the ability to specify rules for required and optional peer information, plus the ability to load and save peer addresses from a file. =item Message server A message server using HTTP::Daemon. Net::Distributed is subclassable, should you wish to use an alternative transport =item Message sending Message sending using HTTP::Request. Net::Distributed is subclassable, should you wish to use an alternative transport =item De/serialization Net::Distributed::Message objects provide default methods for serialization and deserialization =item Message handlers Net::Distributed::Message::Handler objects provide message handling services to the Net::Distributed object, and may also provide utility methods. =back =cut use HTTP::Daemon; use LWP::UserAgent; use Socket; use Sys::Hostname; use Net::Distributed::AddressBook; use Net::Distributed::PeerAddress; use Net::Distributed::Message; use Net::Distributed::Mixin qw/configure _debug/; use Net::Distributed::Handler::Joiner; use Data::Dumper; use Carp qw/cluck confess/; use strict; use vars qw/$AUTOLOAD $VERSION/; $VERSION = 0.1; =head1 METHODS =over 4 =item new Net::Distributed(%options) Options include =over 6 =item address Passed to HTTP::Daemon to provide the local IP address and port. Net::Distributed will try to guess it if you don't provide this. =item message_class The class to use for messages. Should be a subclass of Net::Distributed::Message (which is the default) =item address_class The class to use for peer addresses. Should be a subclass of Net::Distributed::PeerAddress (which is the default). =item services An arrayref of Net::Distributed::Handler class names. Handlers will be created as objects of these classes, and any service methods imported. As a piece of syntactic sugar, if you specify a name beginning with a colon (:), it will be appended to 'Net::Distributed::Handler:' to form the full service name. =item email An email address to contact. This will be sent with messages as an HTTP header. =item addressbook A Net::Distributed::AddressBook object to act as the addressbook for this peer. If this is not specified, a new one will be created. =item debug Turn on debugging warning messages. =item timeout Sets the timeout for the HTTP::Daemon to listen. If this is set, after timeing out the internal_processing method will be called and the HTTP::Daemon will listen again. Otherwise, the HTTP::Daemon blocks. =item handlers An arrayref to some Net::Distributed::Handler objects. You can combine this with the (simpler) "services" option. =item initial_addresses An arrayref of addresses. The Distributed object will attempt to join these networks before entering the main "run" loop. (This should really be in N::D::H::Joiner). =back Many of these items can be specified later, by calling AUTOLOADed meth +ods, e.g. $distributed->timeout(5); =cut sub new { my $class = shift; my $self = {}; bless $self, $class; $self->configure(@_); $self->{handlers} ||= []; foreach (@{$self->services}) { $_ = "Net::Distributed::Handler:$_" if $_ =~ /^:/; import $_ qw/:default/; push @{$self->handlers}, $_->new; } unless ($self->address) { $self->address( inet_ntoa(scalar gethostbyname( hostname() || 'localho +st')) . '6787' # randomly chosen ); } $self->{message_class} ||= 'Net::Distributed::Message'; $self->{address_class} ||= 'Net::Distributed::PeerAddress'; $self->{addressbook} ||= new Net::Distributed::AddressBook ( address_class => $self->{address_class} ); return $self; } =item $distributed->run Starts the object running, listening for messages and performing regular internal processing. =cut sub run { my $self = shift; if ($self->initial_addresses) { $self->send_join_request(address => $_) foreach @{ $self->initial_addresses}; } RUN: while(1) { MESSAGE: while (my ($message_string, $peer_address) = $self->_accept_messages ) { last MESSAGE unless $message_string; # parse into Message object my $message; $message = $self->deserialize_message( $message_string ); $self->_debug("Received message:\n" . (Dumper $message)); unless (ref $message) { warn "Could not parse message string:\n" . "$message_string\nignoring" ; next MESSAGE; } if ($peer_address) { $message->from($peer_address); } $self->dispatch($message); } $self->internal_processing; } } =item $distributed->handlers_for($arg) Returns an array of Handler objects for $arg, which can be a Message object or a message type string. =cut sub handlers_for { my $self = shift; my $arg = shift; my $type = ref $arg ? $arg->type : $arg; return grep { $_->can_handle($type) } @{ $self->handlers }; } sub dispatch { my $self = shift; my $message = shift; foreach (@{$self->handlers}) { if ($_->can_handle($message)) { my $continue = $_->handle($self, $message); return unless $continue; # pass the message to other handl +ers } } } # parametrized factory methods sub deserialize_message { my $self = shift; $self->message_class->deserialize(@_); } =item $distributed->create_message(%options) Parametrized factory method to create a new Message object. Uses $distributed->{message_class}. =cut sub create_message { my $self = shift; $self->message_class->new(@_); } =item $distributed->create_address(%options) Parametrized factory method to create a new PeerAddress object. Uses $distributed->{address_class}. =cut sub create_address { my $self = shift; $self->address_class->new(@_); } =item $distributed->create_address(%options) Parametrized factory method to create a new PeerAddress object from a message. Uses $distributed->{address_class}. =cut sub address_from_message { my $self = shift; $self->address_class->new_from_message(@_); } # delegation =item $distributed->add_peer(@peers) Adds one or more PeerAddress objects to the address book. =cut sub add_peer { my $self = shift; foreach (@_) { if ($self->address eq $_->address) { cluck "Trying to add myself to my addressbook"; } } $self->addressbook->add(@_); } sub peers { my $self = shift; $self->addressbook->get_all; } sub next_peer { my $self = shift; $self->addressbook->next; } sub any_peer { my $self = shift; my @peers = $self->peers; return $peers[0]; } =item $distributed->send_message($message, @peers) Sends a Message object to a list of PeerAddresses. The message "originator" value is automatically set to your peer's address (normally "host:port"), unless it is already set. =cut sub send_message { my $self = shift; my $message = shift; my @peers = @_; $self->_debug('sending message'); return 0 unless @peers; unless ($message->originator) { $message->originator($self->address); } $message->from($self->address); my $message_string = $message->serialize; my $all_succeeded = 1; foreach (@peers) { my $success = $self->_transport_message($message_string,$_); unless ($success) { $self->_debug("Could not send message to " . $_->address); $all_succeeded = 0; } } return $all_succeeded; } =item $distributed->internal_processing A virtual method. Do something interesting here in your subclasses. =cut # virtual method sub internal_processing { my $self = shift; return; } =item AUTOLOADED methods You can access all object attributes using AUTOLOADed methods. E.g. $distributed->daemon; # accesses the HTTP::Daemon object used f +or receiving messages $distributed->email; $distributed->addressbook; $distributed->UserAgent; # accesses the LWP::UserAgent object f +or sending messages You can also set these attributes in the same way, e.g. $distributed->UserAgent($my_special_user_agent); $distributed->debug(1); # turn on debugging warnings $distributed->details(\%some_details); # creates details hash w +hich will be passed to accepted peers In either case they return the old attribute. =cut sub AUTOLOAD { my $self = shift; my $attribute = $AUTOLOAD; $attribute =~ s/.*:://; my $old = $self->{$attribute}; $self->{$attribute} = shift if @_; return $old; } sub DESTROY { # do not autoload me } =item $distributed->_accept_messages This private method returns messages, one at a time, to the "run" method. You can subclass it to provide an alternative transport. The method should return a string which can then be parsed into a Net::Distributed::Message object. Actually, the method can return two values. The optional second value is a PeerAddress object representing the address of the sender. This is for use if you can reliably determine the sender's address from the transport mechanism. (The default method can get the IP address of the peer but not the lis +tening port, so it does not return a second value.) If you don't return a second value, the sender address will be determined by parsing the message. =cut sub _accept_messages {# how to do timeouts n queues? my $self = shift; unless ($self->{daemon}) { my ($localaddr, $localport) = split /:/, $self->address; $self->{daemon} = new HTTP::Daemon ( LocalAddr => $localaddr, LocalPort => $localport ); ref $self->{daemon} or die "Could not create HTTP::Daemon $! $ +@"; $self->{daemon}->timeout($self->timeout) if $self->timeout; } CONNECTION: while (1) { my $conn = $self->{daemon}->accept; # blocks return undef unless $conn; my $req = $conn->get_request; if ($req->method ne 'POST') { my $r = new HTTP::Response (405,'POST method only' ); $conn->send_response($r); $conn->close; next CONNECTION; } elsif (my $content = $req->content) { my $r = new HTTP::Response(200, 'OK'); $conn->send_response($r); $conn->close; return $content; } } } =item _transport_message This private method transports a message string to a server. Subclass it to provide an alternative transport: sub _transport_message { my $self = shift; my ($message_string, $peer) = shift; ...[send message] } =cut sub _transport_message { # subclassability! my $self = shift; my $message_string = shift; my $peer = shift; $peer or confess "no peer"; my $headers = new HTTP::Headers; $headers->date(time); $headers->content_type('text/plain'); $headers->server('Net::Distributed'); my $request = new HTTP::Request ( 'POST', "http://" . $peer->address, $headers, $message_string ); unless ($self->{UserAgent}) { $self->{UserAgent} = new LWP::UserAgent; $self->{UserAgent}->agent ("Net::Distributed/$VERSION"); $self->{UserAgent}->from ($self->email); $self->{UserAgent}->parse_head(0); $self->{UserAgent}->timeout(120); } my $ua = $self->{UserAgent}; my $response = $ua->request($request); if ($response->is_success) { $self->_debug("Sent message to " . $peer->address); return 1; # of course, there may be problems further down the +line } else { $self->_debug("Got " . $response->status_line . " from " . $pe +er->address); return 0; } } =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright 2001, David Hugh-Jones. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Bugs, comments and wishlist items to davidhj@mail.com =head1 SEE ALSO L<Net::Distributed::Message> L<Net::Distributed::AddressBook> L<Net::Distributed::PeerAddress> L<Net::Distributed::Handler> L<HTTP::Daemon> =cut 1; package Net::Distributed::Mixin; use Carp qw/cluck/; use Exporter; use strict; use vars qw/@ISA @EXPORT_OK/; @ISA = qw/Exporter/; @EXPORT_OK = qw/configure _debug/; =head1 NAME Net::Distributed::Mixin =head1 SYNOPSIS use Net::Distributed::Mixin qw/configure _debug/; =head1 DESCRIPTION Provides generic, exportable functions for Net::Distributed objects. =cut =head sub _handle { my $self = shift; my $type = shift; if (ref $self->{$type} eq 'CODE') { &{ $self->{$type} }($self, @_); } else { my $method = $self->{$type}; my $handler = $self->handler || $self; $handler->$method(@_); } } =cut sub configure { my $self = shift; my %config = @_; map { $self->{$_} = $config{$_}; } keys %config; return $self; } sub _debug { my $self = shift; $self->{debug} && print STDERR "*** $_[0] (from $self)\n"; $self->{debug} > 1 && cluck '$_'; } =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> =cut 1; package Net::Distributed::Message; =head1 NAME Net::Distributed::Message =head1 SYNOPSIS package MyMessage; use strict; use vars qw/@ISA/; @ISA = qw/Net::Distributed::Message/; sub deserialize { my $class = shift; my $message_string = shift; .. deserialize a hashref bless $message, $class; } sub serialize { my $self = shift; ... serialize it return $string; } =head1 DESCRIPTION A simple class to send messages containing Perl data. By default, it uses Storable for serialization: you can subclass it to provide other methods. =head1 METHODS =over 4 =cut use Storable qw/freeze thaw/; use Carp qw/cluck/; use strict; use vars qw/$AUTOLOAD $VERSION/; $VERSION = 0.1; =item $message->type Get/set the type of message? Message type is used by Net::Distributed::Handler objects to decide whether to handle the message. =item $message->originator Get/set the I<original> message sender's address. =item $message->from Get/set the address of the peer from which the message was received (normally as "host:port"). Note that as messages may be forwarded, this will probably I<not> be the same as originator =item $message->body Get/set the message body. This is for client applications to use. It can contain any serializable perl data structure. =item new Net::Distributed::Message(%options) Creates a new message. Options can include type, body and originator. (Not "from" - that is automatically set by the Net::Distributed object when it sends the message. =cut sub new { my $class = shift; my %options = @_; my $self = {}; $self->{type} = $options{type}; $self->{body} = $options{body}; $self->{originator} = $options{originator}; bless $self, $class; } =item Net::Distributed::Message->deserialize($frozenstring); Uses Storable's "thaw" method to return a new message object. Returns false on failure. =cut sub deserialize { my $class = shift; my $string = shift; my $self; eval {$self = thaw $string;}; if ($@) { cluck "Could not deserialize string:\n$string"; return 0;die; } unless (ref $self eq $class) { warn "Deserialized object from string:\n". "$string\n". "was of type " . ref $self . ", not of type $class"; return 0; } unless ($self->{type}) { warn "Deserialized message:\n$string\nhad no type attribute"; return 0; } unless ($self->{originator}) { warn "Deserialized message:\n$string\nhad no originator attrib +ute"; return 0; } return $self; # already blessed by the thaw mechanism! } =item $message->serialize; Returns a serialization of the message using Storable's "freeze". =cut sub serialize { my $self = shift; my $string = freeze $self; return $string; } sub AUTOLOAD { # get or set instance variables my $self = shift; my $attribute = $AUTOLOAD; $attribute =~ s/.*:://; my $old = $self->{$attribute}; $self->{$attribute} = shift if @_; return $old; } sub DESTROY { # do not autoload me } =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> L<Net::Distributed::Handler> =cut 1; package Net::Distributed::PeerAddress; =head1 NAME Net::Distributed::PeerAddress =head1 SYNOPSIS package MyAddress; use strict; use vars qw/@ISA/; @ISA = qw/Net::Distributed::PeerAddress/; ... new methods =head1 DESCRIPTION Class to store details of a Net::Distributed object's peers on a given network. =head1 METHODS =over 4 =cut use strict; use vars qw/$VERSION $AUTOLOAD/; $VERSION = 0.1; =item Net::Distributed::PeerAddress->new(address => $address,[ $more_o +ptions ]); Creates a new PeerAddress object. You must specify the address. Normally this will be in "host:port" format, but you can use other formats if you have subclassed Net::Distributed to use a different transport than HTTP. =cut sub new { my $class = shift; my %details = @_; my $self = {}; while (my ($k,$v) =each %details) { $self->{$k} = $v; } unless ($self->{address}) { warn "Address details must include address => 'Address'"; return undef; } bless $self, $class; } =item Net::Distributed::PeerAddress->new_from_message($message) Attempts to create a new PeerAddress object using details embedded in a Net::Distributed::Message. The message body may contain a "details" key, which references a hash of address details; and either the message "originator" must be set, or the details key must contain an "address", element. (If both are set, the value in "details" will be used instead of the "originator"). Returns undef on failure. =cut sub new_from_message { my $class = shift; my $message = shift; my $details; if ( $message->body) { $details = $message->body->{details}; } unless ($details->{address} ||= $message->originator) { warn "Could not find message originator in message"; return undef; } my $self = $class->new( %$details ); return $self; } =item $peer->alter_details(%new_details) Alters the specified details for the peer. =cut sub alter_details { my $self = shift; my %details = @_; if ( defined $details{address} and not $details{address} ) { warn "Address details must include a proper address"; return undef; } while (my ($k,$v) =each %details) { $self->{$k} = $v; } return $self; } =item AUTOLOAD methods You can access address attributes using AUTOLOADed methods. E.g. $peer->address, $peer->details You can also set these attributes in the same way, e.g. $peer->address('111.222.333.444:1234'). In either case they return the old attribute. The only attribute that is guaranteed to be returned is "address", alt +hough addresses in a particular addressbook may conform to more stringent ru +les. =cut sub AUTOLOAD { # get or set instance variables my $self = shift; my $attribute = $AUTOLOAD; $attribute =~ s/.*:://; my $old = $self->{$attribute}; $self->{$attribute} = shift if @_; return $old; } sub DESTROY { # do not autoload me } =back =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> L<Net::Distributed::AddressBook> =cut 1; package Net::Distributed::Handler; =head1 NAME Net::Distributed::Handler =head1 SYNOPSIS package Net::Distributed::Handler::MyHandler; use Net::Distributed::Handler; use strict; use vars qw/@ISA @EXPORT_OK %EXPORT_TAGS %TYPES/; @ISA = qw/Net::Distributed::Handler/; @EXPORT_OK = qw/service_method/; %EXPORT_TAGS = ( default => \@EXPORT_OK ); %TYPES = ( message_type => 'handler_method', ); sub handler_method { my $self = shift; my ($d, $message) = @_; # $d is a Net::Distributed object ... return 1; # to pass the message to other handlers # return false to prevent other handlers # viewing the message } sub service_method { my $self = shift; # a Net::Distributed object ... send a message of the appropriate type } =head1 DESCRIPTION Net::Distributed::Handler is an abstract class for providing message handling services to Net::Distributed objects. Messages to handle are defined in the class variable %TYPES, where keys are message types and values are names of class methods. Service methods will be provided to the Net::Distributed object if they are listed by the ":default" export tag. You still have to "use" the class, though. =head1 METHODS =over 4 =cut use Net::Distributed::Mixin qw/configure/; use Exporter; use strict; use vars qw/%TYPES @EXPORT_OK %EXPORT_TAGS @ISA/; @ISA = qw/Exporter/; @EXPORT_OK = qw//; %EXPORT_TAGS = ( default => [] ); %TYPES = (); =item $handler->new(%options) Initializes a handler with %options as attributes, and sets the types of messages it handles using the class variable %TYPES =cut sub new { my $class = shift; my $self = {}; bless $self, $class; $self->configure(@_); no strict 'refs'; $self->{types} = \%{"${class}::TYPES"}; return $self; } =item $handler->can_handle($arg) Returns a method name if $handler can handle $arg ($arg can be a type name, or a Net::Distributed::Message object). Returns undef otherwise. =cut sub can_handle { my $self = shift; my $arg = shift; my $type = ref $arg ? $arg->type : $arg; return $self->{types}->{$type}; # a method name or undef } =item $handler->handle($distributed, $message) Handles a message for the Net::Distributed object $distributed This is normally called from $distributed->dispatch. =cut sub handle { my $self = shift; my ($d,$message) = @_; my $method = $self->{types}->{$message->type}; no strict 'subs'; $self->$method($d,$message); } =back =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> =cut 1; package Net::Distributed::Handler::Joiner; =head1 NAME Net::Distributed::Handler::Joiner =head1 SYNOPSIS use Net::Distributed::Handler::Joiner; my $server = new Net::Distributed ( address => '127.0.0.1:4877', services => [qw/:Joiner/], ... ); =head1 DESCRIPTION A Handler object which provides basic peer acceptance functions. =head1 METHODS =over 4 =cut use Net::Distributed::Handler; use strict; use vars qw/@ISA %TYPES @EXPORT_OK %EXPORT_TAGS/; @EXPORT_OK = qw/send_join_request accept_peer/; %EXPORT_TAGS = ( default => \@EXPORT_OK ); @ISA = qw/Net::Distributed::Handler/; %TYPES = ( join_request => 'handle_join_request', join_accept => 'handle_join_accept', ); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{policy} ||= 'accept'; return bless $self, $class; } =item $joiner->policy([$policy]) Set's the acceptance policy to 'accept' (accept all join requests), 'reject', 'forward' (forwards join requests to a single random peer) or 'broadcast' (forwards the request to all known peers). The default policy is 'accept'. =cut sub policy { my $self = shift; my $oldpol = $self->{policy}; if (@_) { $self->{policy} = shift; } return $oldpol; } =back =head1 HANDLER METHODS =over 4 =item $joiner->handle_join_request Handles messages of type 'join_request' in accordance with the policy specified. =cut sub handle_join_request { my $self = shift; my ($d,$message) = @_; my $policy = $self->{policy}; if ($policy eq 'accept') { my $peer = $d->address_from_message($message); $d->accept_peer($peer) if $peer; } elsif ($policy eq 'reject') { return; } elsif ($policy eq 'forward') { my $peer = $d->any_peer; $d->send_message($message, $peer) if $peer; } elsif ($policy eq 'broadcast') { my @peers = $d->peers; foreach (@peers) { $d->send_message($message, $_); } } else { die "Policy $policy not recognized"; } } =item $joiner->handle_join_accept Adds the accepting peer to the Distributed object's addressbook =back =cut sub handle_join_accept { my $self = shift; my ($d,$message) = @_; my $peer = $d->address_from_message($message); $d->add_peer($peer) if $peer; } =head1 SERVICE METHODS These methods are exported for use by the Net::Distributed object. =over 4 =item $distributed->send_join_request( address => $remote, body => $body ); Sends a new join_request message to the remote address specified (norm +ally in the form "host:port", but you could use an alternative form if you have subclassed Net::Distributed). You may not get a reply back immediately, or from the same peer whom you asked, and if you get rejected, you won +'t hear back at all! Note that you don't specify a PeerAddress for this method. If you have + the PeerAddress in your addressbook, they've accepted you already! =cut sub send_join_request { my $self = shift; my %options = @_; my $message = $self->create_message ( type => 'join_request', body => $options{body}, ); my $peer = $self->create_address ( address => $options{address} ); $self->_debug('in send_join_request'); $self->send_message($message,$peer); } =item accept_peer $distributed->accept_peer($peer); Sends a message to the PeerAddress object specified by $peer, acceptin +g them. The message includes address details so that the peer can add you to their addressbook. Als +o adds the peer to your own addressbook. =cut sub accept_peer { my $self = shift; my $peer = shift; $self->add_peer($peer); my $message = $self->create_message( type => 'join_accept', body => { details => $self->details }, ); $self->send_message($message,$peer); } =back =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> L<Net::Distributed::Handler> =cut 1; package Net::Distributed::Handler::Searcher; =head1 NAME Net::Distributed::Handler::Searcher =head1 SYNOPSIS my $server = new Net::Distributed ( address => '127.0.0.1:4877', services => [qw/:Joiner :Searcher/], ... ); $server->send_search($pattern, $peer); =head1 DESCRIPTION A simple example handler to provide searching facilities. This is just a demo, rather than a serious abstract class for searching (at the moment). =cut use Net::Distributed::Handler; use Data::Dumper; use strict; use vars qw/@ISA @EXPORT_OK %EXPORT_TAGS %TYPES/; @ISA = qw/Net::Distributed::Handler/; @EXPORT_OK = qw/broadcast_search send_search return_match/; %EXPORT_TAGS = ( default => \@EXPORT_OK ); %TYPES = ( search => 'handle_search', result => 'handle_result', ); =head1 HANDLER METHODS =over 4 =item $searcher->handle_search Looks for a filename in the current directory matching the pattern in the search request. If a match is found, informs the requesting peer. If none is found, forwards the search to a random peer. (Uses a simple TTL mechanism to prevent infinite forwarding.) =cut sub handle_search { my $self = shift; my ($d, $message) = @_; return unless $message->body->{ttl} > 0; my $pattern = $message->body->{pattern}; my $found; opendir D, "."; foreach (readdir D) { if (/$pattern/) { $found = 1; $d->_debug("Found matching file $_"); $self->return_match($d, $_, $d->address_from_message($mess +age)); } } closedir D; unless ($found) { my $peer = $d->any_peer; $message->body->{ttl}--; $d->send_message($message, $peer) if $peer; } } =item $searcher->handle_result Whoop-de-do, we have a result, and now we can tell the world about it! =back =cut sub handle_result { my $self = shift; my ($d, $message) = @_; my $file = $message->body->{file}; $d->_debug("Peer has file $file"); } =head1 SERVICE METHODS These methods are exported for use by the Net::Distributed object. =over 4 =item $distributed->broadcast_search($pattern) Sends a search for a file matching $pattern to all peers. =cut sub broadcast_search { my $self = shift; my $pattern = shift; foreach ($self->peers) { $self->send_search($pattern, $_); } } =item $distributed->send_search($pattern,$peer) Sends a search for filename matching $pattern to $peer. =cut sub send_search { my $self = shift; my ($pattern, $peer) = @_; my $message = $self->create_message( body => {pattern => $pattern, ttl => 2}, type => 'search', ); $self->send_message($message, $peer); } sub return_match { my $self = shift; my ($d, $file, $peer) = @_; my $message = $d->create_message( type => 'result', body => {file => $file} ); $d->send_message($message, $peer); } =back =head1 AUTHOR David Hugh-Jones (hughjonesd@yahoo.co.uk) Copyright (c) 2002-2003 David Hugh-Jones. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Net::Distributed> L<Net::Distributed::Handler> =cut 1;
In reply to Net::Distributed by dash2
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |