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;