view release on metacpan or  search on metacpan

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

        # get here without a connection, so we need to test for it:
        $conn->on_stream_start($ss) if $conn;
        return;
    }

    # need a connection past this point.
    return unless $conn;

    # if they're not in a stream yet, bail.
    unless ($conn->{in_stream}) {
        $conn->stream_error('invalid-namespace');
        return;
    }

    if ($self->{capture_depth}) {
        push @{$self->{events}}, [EVT_START_ELEMENT, $data];
        $self->{capture_depth}++;
        return;
    }

    # start capturing...
    $self->{"events"} = [
                         [EVT_START_ELEMENT, $data],
                         ];
    $self->{capture_depth} = 1;

    Scalar::Util::weaken($conn);
    $self->{on_end_capture} = sub {
        my ($doc, $events) = @_;
        my $nodes = _nodes_from_events($events);
        # {=xml-stanza}
        my $t1 = Time::HiRes::time();
        $conn->on_stanza_received($nodes->[0]) if $conn;
        my $td = Time::HiRes::time() - $t1;

        # ring buffers for latency stats:
        if ($td > $DJabberd::Stats::latency_log_threshold) {
            $DJabberd::Stats::stanza_process_latency_log[ $DJabberd::Stats::latency_log_index =
                                                          ($DJabberd::Stats::latency_log_index + 1)
                                                          % $DJabberd::Stats::latency_log_max_size
                                                          ] = [$td, $nodes->[0]->as_xml];
        }

        $DJabberd::Stats::stanza_process_latency[ $DJabberd::Stats::latency_index =
                                                  ($DJabberd::Stats::latency_index + 1)
                                                   % $DJabberd::Stats::latency_max_size
                                                  ] = $td;
    };
    return;
}

sub characters {
    my ($self, $data) = @_;

    if ($self->{capture_depth}) {
        push @{$self->{events}}, [EVT_CHARS, $data];
    }

    # TODO: disconnect client if character data between stanzas?  as
    # long as it's not whitespace, because that's permitted as a
    # keep-alive.

}

sub end_element {
    my ($self, $data) = @_;

    if ($data->{NamespaceURI} eq "http://etherx.jabber.org/streams" &&
        $data->{LocalName} eq "stream") {
        $self->{ds_conn}->end_stream if $self->{ds_conn};
        return;
    }

    if ($self->{capture_depth}) {
        push @{$self->{events}}, [EVT_END_ELEMENT, $data];
        $self->{capture_depth}--;
        return if $self->{capture_depth};
        my $doc = undef;
        if (my $cb = $self->{on_end_capture}) {
            $cb->($doc, $self->{events});
        }
        return;
    }
}

sub _nodes_from_events {
    my ($evlist, $i, $end) = @_;
    $i   ||= 0;
    $end ||= scalar @$evlist;
    my $nodelist = [];    # what we're returning (nodes are text or XMLElement nodes)

    while ($i < $end) {
        my $ev = $evlist->[$i++];

        if ($ev->[0] == EVT_CHARS) {
            my $text = $ev->[1]{Data};
            if (@$nodelist == 0 || ref $nodelist->[-1]) {
                push @$nodelist, $text;
            } else {
                $nodelist->[-1] .= $text;
            }
            next;
        }

        if ($ev->[0] == EVT_START_ELEMENT) {
            my $depth = 1;
            my $start_idx = $i;  # index of first potential body node

            while ($depth && $i < $end) {
                my $child = $evlist->[$i++];

                if ($child->[0] == EVT_START_ELEMENT) {
                    $depth++;
                } elsif ($child->[0] == EVT_END_ELEMENT) {
                    $depth--;
                }
            }
            die "Finished events without reaching depth 0!" if $depth;

            my $end_idx = $i - 1;  # (end - start) == number of child elements