File Coverage

blib/lib/JOAP/Proxy/Package/Server.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

# JOAP::Proxy::Package::Server -- Base Class for Proxies of JOAP Server
#
# Copyright (c) 2003, Evan Prodromou
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

# tag: JOAP server proxy base class

package JOAP::Proxy::Package::Server;
use JOAP;
use JOAP::Proxy::Package;
use JOAP::Proxy::Server;
use base qw/JOAP::Proxy::Package JOAP::Proxy::Server/;

use 5.008;
use strict;
use warnings;

our %EXPORT_TAGS = ( 'all' => [ qw// ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw//;

our $VERSION = $JOAP::VERSION;

JOAP::Proxy::Package::Server->mk_classdata('Address');
JOAP::Proxy::Package::Server->mk_classdata('Classes');
JOAP::Proxy::Package::Server->mk_classdata('ClassProxy');

JOAP::Proxy::Package::Server->Address('');
JOAP::Proxy::Package::Server->Classes([]);
JOAP::Proxy::Package::Server->ClassProxy({});

sub classes {
    my $self = shift;
    return $self->Classes(@_);
}

sub address {
    my $self = shift;
    return $self->Address(@_);
}

sub _describe {

    my $self = shift;
    my $resp = $self->SUPER::_describe(@_);

    # Need to get the classes, too.

    my @classes = $resp->GetQuery->GetClass;
    $self->Classes(\@classes);

    # XXX: update addresses for classes in classmap

    return $resp;
}

sub proxy_class {

    my $self = shift;
    my $class_address = shift;

    my $jid = new Net::Jabber::JID($class_address);

    if ($jid->GetServer ne $self->address) {
        return undef;
    }

    my $class_id = $jid->GetUserID;

    if (!$class_id) {
        return undef;
    }

    my $class = $self->ClassProxy->{$class_id};

    if (!$class) {
        return undef;
    }

    $class->Address($class_address);

    $class->refresh;

    return $class;
}

sub method {
    my $self = shift;
    my $name = shift;

    my $desc = $self->_method_descriptor($name);
    my $method = $self->_proxy_method($desc);

    return $method;
}

sub accessor {
    my $self = shift;
    my $name = shift;

    my $desc = $self->_attribute_descriptor($name);
    my $accessor = $self->_proxy_accessor($desc);

    return $accessor;
}

1;  # gotta return something true

__END__