#!/usr/bin/perl -w
$SRC
=
"User\@example.net/Client"
;
$DEST
=
"Person\@joap.example.com/Prodromou,Evan"
;
$DESTCLASS
=
"Person\@joap.example.com"
;
$ID
=
'joap_read_1'
;
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DEST
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'get'
);
my
$read
=
$iq
->NewQuery(
$JOAP::NS
,
'read'
);
$read
->SetName(
'age'
);
ok(
$read
->DefinedName,
"Name field is defined."
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DEST
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'read'
,
"Reply query is a <read>"
);
ok(!
$replq
->DefinedName,
"Name field was not passed through."
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DEST
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'set'
);
my
$edit
=
$iq
->NewQuery(
$JOAP::NS
,
'edit'
);
$edit
->AddAttribute(
name
=>
'age'
)->AddValue(
i4
=> 34);
ok(
$edit
->DefinedAttribute,
"Name field is defined."
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DEST
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'edit'
,
"Reply query is a <edit>"
);
ok(!
$replq
->DefinedAttribute,
"Attribute field was not passed through."
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DESTCLASS
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'set'
);
my
$add
=
$iq
->NewQuery(
$JOAP::NS
,
'add'
);
$add
->AddAttribute(
name
=>
'age'
)->AddValue(
i4
=> 34);
$add
->AddAttribute(
name
=>
'first'
)->AddValue(
string
=>
'Evan'
);
$add
->AddAttribute(
name
=>
'last'
)->AddValue(
string
=>
'Prodromou'
);
ok(
$add
->DefinedAttribute,
"Name field is defined."
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DESTCLASS
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'add'
,
"Reply query is a <add>"
);
ok(!
$replq
->DefinedAttribute,
"Attribute field was not passed through."
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DEST
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'set'
);
my
$delete
=
$iq
->NewQuery(
$JOAP::NS
,
'delete'
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DEST
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'delete'
,
"Reply query is a <delete>"
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DEST
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'set'
);
my
$search
=
$iq
->NewQuery(
$JOAP::NS
,
'search'
);
$search
->AddAttribute(
name
=>
'age'
)->AddValue(
i4
=> 34);
ok(
$search
->DefinedAttribute,
"Name field is defined."
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DEST
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'search'
,
"Reply query is a <search>"
);
ok(!
$replq
->DefinedAttribute,
"Attribute field was not passed through."
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}
{
my
$iq
= new Net::Jabber::IQ();
$iq
->SetTo(
$DEST
);
$iq
->SetFrom(
$SRC
);
$iq
->SetID(
$ID
);
$iq
->SetType(
'set'
);
my
$describe
=
$iq
->NewQuery(
$JOAP::NS
,
'describe'
);
my
$reply
= JOAP::Server::Object->reply(
$iq
);
ok(
$reply
,
"Can create a reply."
);
is(
$reply
->GetType,
"result"
,
"Reply type is a result"
);
is(
$reply
->GetTo,
$SRC
,
"Reply destination is correct"
);
is(
$reply
->GetFrom,
$DEST
,
"Reply source is correct"
);
is(
$reply
->GetID,
$ID
,
"Reply id is correct"
);
my
$replq
=
$reply
->GetQuery();
ok(
$replq
,
"Can get reply query"
);
is(
$replq
->GetXMLNS,
$JOAP::NS
,
"Reply query is in the right NS"
);
is(
$replq
->GetTag,
'describe'
,
"Reply query is a <describe>"
);
$reply
->SetType(
'error'
);
is(
$reply
->GetType,
'error'
,
'Set the type to error correctly'
);
$reply
->SetErrorCode(406);
$reply
->SetError(
'Not acceptable'
);
is(
$reply
->GetErrorCode, 406,
"Set error type correctly."
);
is(
$reply
->GetError,
'Not acceptable'
,
'Set error text correctly.'
);
}