File Coverage

blib/lib/JOAP/Proxy/Instance.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::Instance.pm - class for Instances
#
# Copyright (c) {$YEAR}, {$NAME} {$EMAIL}.
#
# 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 class proxy instance class

package JOAP::Proxy::Instance;
use JOAP::Proxy;
use base qw/JOAP::Proxy/;

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;
our $AUTOLOAD;

sub get {

    my $proto = shift;
    my $pkg = ref($proto) || $proto;
    my $address = shift;
    my $self = bless({_address => $address}, $pkg);

    my %named = @_;

    # If these are passed in, we don't have to do a describe.

    if (defined $named{methods} &&
        defined $named{attributes} &&
        defined $named{superclasses} &&
        defined $named{timestamp} &&
        defined $named{description})
      {
        $self->methods($named{methods});
        $self->attributes($named{attributes});
        $self->superclasses($named{superclasses});
        $self->_set_timestamp($named{timestamp});
        $self->_set_description($named{description});
    }

    $self->_read();

    return $self;
}

sub superclasses {
    my $self = shift;
    return (@_) ? $self->{_superclasses} = shift : $self->{_superclasses};
}

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

    my @classes = $resp->GetQuery->GetSuperclass;
    $self->superclasses(\@classes);

    return $resp;
}

sub _edit {

    my $self = shift;
    my $resp = $self->SUPER::_edit(@_);
    my $edit = $resp->GetQuery;

    if (ref($self) && $edit->DefinedNewAddress) {
	$self->address($edit->GetNewAddress);
    }

    return $resp;
}

sub _default_edit_attrs {

    my $self = shift;

    # This _should_ return only writable attributes

    my $attrs = $self->SUPER::_default_edit_attrs;

    my @right_alloc = grep { $attrs->{$_}->{allocation} ne 'class' } keys %$attrs;

    # make that into a hash

    my %write = map {($_, $attrs->{$_})} @right_alloc;

    # return a reference to that hash

    return \%write;
}

sub delete {

    my $self = shift;

    my $con = $self->Connection || throw JOAP::Proxy::Error::Local("Can't delete without a connection.");

    my $iq = new Net::Jabber::IQ();

    $iq->SetIQ(to => $self->address, type => 'set');
    $iq->NewQuery($JOAP::NS, 'delete');

    my $resp = $con->SendAndReceiveWithID($iq);

    if ($resp->GetType eq 'error') {
	throw JOAP::Proxy::Error::Remote(value => $resp->GetErrorCode, text => $resp->GetError);
    }

    return 1;
}

sub can {
    my $self = shift;
    my $name = shift;
    my $func = $self->UNIVERSAL::can($name); # See if it's findable by standard lookup.

    if (!$func) { # if not, see if it's something we should make ourselves.
        my $methdesc = $self->_method_descriptor($name);

        if ($methdesc && $methdesc->{allocation} ne 'class') {
            $func = $self->_proxy_method($methdesc);
	} else {
            my $attrdesc = $self->_attribute_descriptor($name);
            if ($attrdesc && $attrdesc->{allocation} ne 'class') {
                $func = $self->_proxy_accessor($attrdesc);
            }
        }
    }

    return $func;
}

1;  # don't forget to return a true value from the file

__END__