view release on metacpan or  search on metacpan

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

sub get_secret_key_by_handle {
    my ($self, $handle, $cb) = @_;
    if ($handle eq "i") {
        # internal
        $cb->($self->{server_secret});
    } else {
        # bogus handle.  currently only handle "i" is supported.
        $cb->(undef);
    }
}

sub get_roster {
    my ($self, $jid, %meth) = @_;
    my $good_cb = delete $meth{'on_success'};
    my $bad_cb  = delete $meth{'on_fail'};
    Carp::croak("unknown args") if %meth;

    my $barestr = $jid->as_bare_string;

    # see if it's cached.
    if (my $roster = $self->{roster_cache}{$barestr}) {
        if ($roster->inc_cache_gets >= 3) {
            delete $self->{roster_cache}{$barestr};
        }
        $good_cb->($roster);
        return;
    }

    # upon connect there are three immediate requests of a user's
    # roster, then pretty much never again, but those three can,
    # depending on the client's preference between sending initial
    # presence vs. roster get first, be 3 loads in parallel, or 1,
    # then 2 in parallel.  in any case, multiple async loads can be in
    # flight at once, so let's keep a list of roster-wanters and only
    # do one request, then send the answer to everybody.  the
    # $kick_off_load is to keep track of whether or not this is the
    # first request that actually has to start loading it, or we're a
    # 2nd/3rd caller.
    my $kick_off_load = 0;

    my $list = $self->{roster_wanters}{$barestr} ||= [];
    $kick_off_load = 1 unless @$list;
    push @$list, [$good_cb, $bad_cb];
    return unless $kick_off_load;

    $self->run_hook_chain(phase => "RosterGet",
                          args  => [ $jid ],
                          methods => {
                              set_roster => sub {
                                  my $roster = $_[1];
                                  $self->{roster_cache}{$barestr} = $roster;

                                  # upon connect there are three immediate requests of a user's
                                  # roster, then pretty much never again, so we keep it cached 5 seconds,
                                  # then discard it.
                                  Danga::Socket->AddTimer(5.0, sub {
                                      delete $self->{roster_cache}{$barestr};
                                  });

                                  # call all the on-success items, but deleting the current list
                                  # first, lest any of the callbacks load more roster items
                                  delete $self->{roster_wanters}{$barestr};
                                  my $done = 0;
                                  foreach my $li (@$list) {
                                      $li->[0]->($roster);
                                      $done = 1 if $roster->inc_cache_gets >= 3;
                                  }

                                  # if they've used it three times, they're done with
                                  # the initial roster, probes, and broadcast, so drop
                                  # it early, not waiting for 5 seconds.
                                  if ($done) {
                                      delete $self->{roster_cache}{$barestr};
                                  }
                              },
                          },
                          fallback => sub {
                              # call all the on-fail items, but deleting the current list
                              # first, lest any of the callbacks load more roster items
                              delete $self->{roster_wanters}{$barestr};
                              foreach my $li (@$list) {
                                  $li->[1]->() if $li->[1];
                              }
                          });
}

# $jidarg can be a $jid for now.  future:  arrayref of jid objs
# $cb is $cb->($map) where $map is hashref of fulljidstr -> $presence_stanza_obj
sub check_presence {
    my ($self, $jidarg, $cb) = @_;

    my %map;
    my $add_presence = sub {
        my ($jid, $stanza) = @_;
        $map{$jid->as_string} = $stanza;
    };

    # this hook chain is a little different, it's expected
    # to always fall through to the end.
    $self->run_hook_chain(phase => "PresenceCheck",
                           args  => [ $jidarg, $add_presence ],
                           fallback => sub {
                               $cb->(\%map);
                           });
}

sub debug {
    my $self = shift;
    return unless $self->{debug};
    printf STDERR @_;
}


# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End:

1;