carp
croak
cluck
)
;
use
vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS)
;
$VERSION
= 0.05;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw(
iname_lookup
inumber_lookup
lookup
)
;
%EXPORT_TAGS
= ( );
@EXPORT_OK
=
qw($Var1 %Hashit &func3)
;
use
vars
qw($Var1 %Hashit)
;
my
%fields
= (
target
=>
undef
,
secret
=>
undef
,
resolve
=> 1,
server
=>
undef
,
context
=> 0
);
our
$AUTOLOAD
;
our
$USE_LOCAL_MESSAGE
= 1;
sub
new {
my
$class
=
shift
;
my
$xdi
=
shift
;
my
$self
= {
%fields
,};
bless
(
$self
,
$class
);
if
(
ref
$xdi
ne
'XDI'
) {
my
(
$p
,
$s
) = XDI->s_debug();
carp
"$p requires object 'XDI' in $s"
;
return
undef
;
}
else
{
$self
->{
'__xdi__'
} =
$xdi
;
}
my
(
$var_hash
) =
@_
;
if
(
defined
$var_hash
) {
if
(
ref
$var_hash
eq
"HASH"
){
foreach
my
$varkey
(
keys
%{
$var_hash
}) {
if
(
exists
$self
->{
$varkey
}) {
$self
->{
$varkey
} =
$var_hash
->{
$varkey
};
}
}
}
else
{
croak
"Initialization failed: parameters not passed as hash reference or iname string"
;
}
}
$self
->{
'server'
} = lookup(
$self
->target)->[2]
unless
(
defined
$self
->{
'server'
});
return
$self
;
}
sub
message {
my
$self
=
shift
;
my
$msg
= XDI::Message->new(
@_
);
$msg
->from_graph(
$self
->__xdi__->from_graph);
$msg
->from(
$self
->__xdi__->from);
$msg
->target(
$self
->target);
$msg
->secret(
$self
->secret)
if
(
defined
$self
->secret);
return
$msg
;
}
sub
post {
my
$self
=
shift
;
my
$logger
= get_logger();
my
(
$msg
,
$test
) =
@_
;
my
$body
;
if
(
ref
$msg
eq
'XDI::Message'
) {
$body
=
$msg
->to_string();
}
elsif
(
ref
$msg
eq
''
) {
$body
=
$msg
;
}
else
{
return
undef
;
}
my
$resp
= _post(
$self
->server,
$body
,
$self
->context);
if
(
defined
$resp
) {
return
_xdi_response(
$resp
);
}
else
{
return
undef
;
}
}
sub
_post {
my
(
$server
,
$body
,
$context
) =
@_
;
my
$logger
= get_logger();
my
$request
= HTTP::Request->new(
'POST'
,
$server
);
my
$ua
= new LWP::UserAgent;
my
$cheader
=
'application/xdi+json'
;
if
(
$context
) {
$cheader
.=
';contexts=1'
;
}
$request
->header(
'accept'
=>
$cheader
);
$request
->content(
$body
);
my
$response
=
$ua
->request(
$request
);
my
$code
=
$response
->code;
if
(
$response
->is_success()) {
return
$response
->content;
}
else
{
carp
"Post: "
,
$response
->status_line;
return
undef
;
}
}
sub
_xdi_response {
my
(
$json
) =
@_
;
my
$struct
= XDI::_decode(
$json
);
if
(
defined
$struct
) {
my
$tuple
= XDI::pick_xdi_tuple(
$struct
,[
'$false$string'
,
'!'
]);
if
(
defined
$tuple
) {
carp
"XDI server returned \$false: "
,
$tuple
->[2];
return
undef
;
}
else
{
return
$struct
;
}
}
return
undef
;
}
sub
lookup {
my
$obj
=
shift
;
my
$xdi
;
if
(
ref
$obj
eq
"XDI::Connection"
) {
$xdi
=
shift
;
}
else
{
$xdi
=
$obj
;
}
if
(XDI::is_inumber(
$xdi
)) {
return
inumber_lookup(
$xdi
);
}
else
{
return
iname_lookup(
$xdi
);
}
}
sub
iname_lookup {
my
$obj
=
shift
;
my
$iname
;
if
(
ref
$obj
eq
"XDI::Connection"
) {
$iname
=
shift
;
}
else
{
$iname
=
$obj
;
}
my
$struct
= xdi_lookup(
$iname
);
my
$temp
= XDI::pick_xdi_tuple(
$struct
,[
$iname
,
'$is'
]);
my
$inumber
=
$temp
->[2];
my
$subject
=
'('
.
$inumber
.
')$!($uri)'
;
$temp
= XDI::pick_xdi_tuple(
$struct
,[
$subject
,
'!'
]);
my
$url
=
$temp
->[2];
return
[
$iname
,
$inumber
,
$url
];
}
sub
inumber_lookup {
my
$obj
=
shift
;
my
$inumber
;
if
(
ref
$obj
eq
"XDI::Connection"
) {
$inumber
=
shift
;
}
else
{
$inumber
=
$obj
;
}
my
$iname
=
undef
;
my
$struct
= xdi_lookup(
$inumber
);
my
$subject
=
'('
.
$inumber
.
')$!($uri)'
;
my
$temp
= XDI::pick_xdi_tuple(
$struct
,[
$subject
,
'!'
]);
my
$url
=
$temp
->[2];
return
[
$iname
,
$inumber
,
$url
];
}
sub
xdi_lookup {
my
$obj
=
shift
;
my
$iname
;
if
(
ref
$obj
eq
"XDI::Connection"
) {
$iname
=
shift
;
}
else
{
$iname
=
$obj
;
}
my
$authority
=
$XRI_AUTHORITY
;
my
$rstruct
= {
"from_graph"
=>
'=1111'
,
"from"
=>
'=1111'
,
"target"
=>
$iname
,
"link_contract"
=>
''
,
};
my
$msg
= XDI::Message->new(
$rstruct
);
$msg
->get(
$iname
);
my
$resp
= _post(
$authority
,
$msg
->to_string);
return
XDI::_decode(
$resp
);
}
sub
set_resolution_authority {
my
(
$authority
) =
@_
;
$XRI_AUTHORITY
=
$authority
;
return
$XRI_AUTHORITY
;
}
sub
AUTOLOAD {
my
$self
=
shift
;
my
$type
=
ref
(
$self
)
or croak
"($AUTOLOAD): $self is not an object"
;
my
$name
=
$AUTOLOAD
;
$name
=~ s/.*://;
unless
(
exists
$self
->{
$name
} ) {
carp
"$name not permitted in class $type"
;
return
;
}
if
(
@_
) {
my
$obj
=
shift
;
if
(
ref
$obj
ne
""
) {
return
$self
->{
$name
} = dclone
$obj
;
}
else
{
return
$self
->{
$name
} =
$obj
;
}
}
else
{
return
$self
->{
$name
};
}
}
sub
DESTROY { }
END { }
1;
Hide Show 202 lines of Pod
=head1 SYNOPSIS
my
$xdi
= new XDI;
my
$c
=
$xdi
->
connect
();
..
my
$xdi_hash
= {
'from'
=>
'=my_graph'
,
'from_graph'
=>
'@xdiserver'
};
my
$xdi
= XDI->new(
$hash
);
my
$c
=
$xdi
->
connect
({
target
=>
'=other_graph'
,
secret
=>
"foosh"
});
=head1 EXPORTS
iname_lookup
inumber_lookup
lookup
=head1 XDI::Connection
Set the target graph and shared secret
for
the object. Default behavior is to
do
a lookup on I<target> to get the inumber and server URI that is hosting the graph. You can
provide either an iname or an inumber as the I<target> value, but the current services
do
not allow an inumber to be resolved back to an iname.
=head1 DESCRIPTION
The XDI perl module provides iname resolution and provides an http post method to
send
messages
=head2 Notation and Conventions
$xdi
Root object defining identity of querier
$c
Connection object defining graph target and permissions
$msg
Message object
for
XDI messages
$hash
Reference to a hash of key/attribute
values
$target
iname or inumber of the graph which is queried
$secret
Shared secret
for
access to the I<target> graph
=head2 Usage Outline
The primary method
for
creating a Connection object is via the C<
connect
()> method of the XDI object
$c
=
$xdi
->
connect
();
You can pass any XDI::Connection initialization parameters to C<
connect
()>
$hash
= {
target
=> E<lt>iname|inumberE<gt>,
secret
=>
$secret
};
$c
=
$xdi
->
connect
(
$hash
);
Given an I<iname>, the
default
behavior
for
XDI is to attempt to resolve the iname to it's
corresponding inumber using the iname resolution service at xri2xdi.net. This service
also returns the URI to the graph that is authoritative
for
said I<iname>, during testing and
development that often proves inconvenient so you can
override
this behavior
$c
->resolve(0);
Of course,
if
you
do
that, you will have to specify the URI of the graph to which you are
sending a query
You may have noticed that we haven't actually I<connected> to anything yet. I reserve the right
to make checking the target graph
for
a valid
link
contract part of the connection process
=head3 secret
=over 2
XDI security policy is currently under discussion by the XDI Technical Committee so the placeholder
for
a more robust policy is to
use
a shared secret. Please note that the policy allows
for
arbitrarily complex expressions and Javascript is proposed
for
the expression syntax. L<https://wiki.oasis-
open
.org/xdi/XdiPolicyExpression> As the policy matures, I expect to need to update the client
=back
$graph
=
$c
->post(
$msg
);
The result is a JSON encoded representation of the nodes requested in the
$get
operation. Other
operations will
return
an empty hash {} upon success. Default behavior is to automatically convert
the JSON to a perl hash object
=head1 SUBROUTINES/METHODS
XDI and it's members support the common PERL OO-style syntax via AUTOLOAD
=head2 Constructor
Generally, the constructor
for
the XDI::Connection object is not called directly.
=head2 Instance variables
Instance variables are only accessible through the respective getter/setter methods. Allowed
variables are:
=over 4
=item C<target>
=item C<secret>
=item C<resolve>
=item C<server>
=item C<context>
=back
=head2 message
$msg
=
$c
->message();
As usual, you can pass valid message constructor parameters to XDI::Connection::message
$msg
=
$c
->message({
link_contract
=>
'=!1111'
});
=head2 post
$result
=
$c
->post(
$msg
);
$result
=
$c
->post(
$xdi_string
);
I<post> accepts either a XDI::Message object or a perl string as a parameter and returns a perl
hash object. Currently
$add
operations
return
an empty hash {}. In case of an HTTP or XDI error,
undef
is returned. The error message can be accessed by encapsulating the post in an
eval
block
eval
{
$result
=
$c
->post(
$msg
);
};
if
($@) {
}
=head2 iname_lookup
$tuple
= iname_lookup(
'=tester'
);
=head2 inumber_lookup
$tuple
= inumber_lookup(
'=!3436.F6A6.3644.4D74'
);
=head2 lookup
$tuple
= lookup(<iname | inumber>);
C<
$tuple
> is [iname,inumber,url]
lookup, iname_lookup, and inumber_lookup are convenience functions to call the XDI resolution service
built into XDI::Connection. C<lookup> uses a simple method to determine whether the parameter
is an inumber or iname and then performs the appropriate I<x_lookup>
Technically, these are both XDI messages to the
$XRI_AUTHORITY
server
but I<x_lookup> encapsulates the whole process into an anonymous XDI message.
=head2 set_resolution_authority
Since the XDI resolution process is still in development, C<set_resolution_authority> allows the
developer to specify explicitly the resolution server. In case the resolution URI changes,
this will allow discovery to
continue
until
the module can be updated
=head1 AUTHOR
Mark Horstmeier <solargroovey
@gmail
.com>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007-2012 Kynetx, Inc.
The perl XDI client is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This program 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 General Public License
for
more details.
You should have received a copy of the GNU General Public
License along
with
this program;
if
not,
write
to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
MA 02111-1307 USA