view release on metacpan or  search on metacpan

lib/DJabberd/Stanza.pm  view on Meta::CPAN

package DJabberd::Stanza;
use strict;
use base qw(DJabberd::XMLElement);
use Carp qw(croak);
use fields (
            'connection',   # Store the connection the stanza came in on so we can respond.
                            # may be undef, as it's a weakref.  if you want to mess with the
                            # structure, you can't do so unless you're the owner, so clone
                            # it first otherwise.
            '_memo_tojid',   # memoized to jid
            '_memo_fromjid', # memoized from jid
            );

sub downbless {
    my $class = shift;
    if (ref $_[0]) {
        my ($self, $conn) = @_;
        my $new = fields::new($class);
        %$new = %$self; # copy fields
        if ($conn) {
            $new->{connection} = $conn;
            Scalar::Util::weaken($new->{connection});
        }
        return $new;
    } else {
        croak("Bogus use of downbless.");
    }

}

sub as_summary {
    my $self = shift;
    return "[Stanza of type " . $self->element_name . " to " . $self->to_jid->as_string . "]";
}

sub on_recv_from_server {
    my ($self, $conn) = @_;
    $self->deliver($conn->vhost);
}

sub process {
    my ($self, $conn) = @_;
    die "$self ->process not implemented\n";
}

sub connection {
    my $self = shift;
    return $self->{connection};
}

sub set_connection {
    my ($self, $conn) = @_;
    $self->{connection} = $conn;
}

# at this point, it's assumed the stanza has passed filtering checks,
# and should be delivered.
sub deliver {
    my ($stanza, $arg) = @_;

    # arg can be a connection, vhost, or nothing.  TODO: kinda ghetto.  fix callers?
    my $vhost;
    if (UNIVERSAL::isa($arg, "DJabberd::VHost")) {
        $vhost = $arg;
    } elsif (UNIVERSAL::isa($arg, "DJabberd::Connection")) {
        $vhost = $arg->vhost;
    } elsif ($stanza->{connection}) {
        $vhost = $stanza->{connection}->vhost;
    }
    Carp::croak("Can't determine vhost delivering: " . $stanza->as_xml) unless $vhost;

    $vhost->hook_chain_fast("deliver",
                            [ $stanza ],
                            {
                               delivered => sub { },
                               # FIXME: in future, this should note deliver was
                               # complete and the next message to this jid should be dequeued and
                               # subsequently delivered.  (in order deliver)
                               error => sub {
                                   my $reason = $_[1];
                                   $stanza->delivery_failure($vhost, $reason);
                               },