Ext/Disco/Info.pm

package Net::XMPP2::Ext::Disco::Info;
use Net::XMPP2::Namespaces qw/xmpp_ns/;

=head1 NAME

Net::XMPP2::Ext::Disco::Info - Service discovery info

=head1 SYNOPSIS

=head1 DESCRIPTION

This class represents the result of a disco info request
sent by a C<Net::XMPP2::Ext::Disco> handler.

=head1 METHODS

=over 4

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = bless { @_ }, $class;
   $self->init;
   $self
}

=item B<xml_node ()>

Returns the L<Net::XMPP2::Node> object of the IQ query.

=cut

sub xml_node {
   my ($self) = @_;
   $self->{xmlnode}
}

=item B<jid ()>

Returns the JID these items belong to.

=cut

sub jid { $_[0]->{jid} }

=item B<node ()>

Returns the node these items belong to (may be undef).

=cut

sub node { $_[0]->{node} }

sub init {
   my ($self) = @_;
   my $node = $self->{xmlnode};
   return unless $node;

   my (@ids) = $node->find_all ([qw/disco_info identity/]);
   for (@ids) {
      push @{$self->{identities}}, {
         category => $_->attr ('category'),
         type     => $_->attr ('type'),
         name     => $_->attr ('name'),
         xml_node => $_,
      };
   }

   my (@fs) = $node->find_all ([qw/disco_info feature/]);
   $self->{features}->{$_->attr ('var')} = $_ for @fs;

}

=item B<identities ()>

Returns a list of hashrefs which contain following keys:

   category, type, name, xml_node

C<category> is the category of the identity. C<type> is the 
type of the identity. C<name> is the human readable name of
the identity and might be undef. C<xml_node> is the L<Net::XMPP2::Node>
object of the <identity/> node.

C<category> and C<type> may be one of those defined on:

   http://www.xmpp.org/registrar/disco-categories.html

=cut

sub identities {
   my ($self) = @_;
   @{$self->{identities}}
}

=item B<features ()>

Returns a hashref of key/value pairs where the key is the feature name
as listed on:

   http://www.xmpp.org/registrar/disco-features.html

and the value is a L<Net::XMPP2::Node> object for the <feature/> node.

=cut

sub features { $_[0]->{features} || {} }


=item B<debug_dump ()>

Prints the information of this Info object to stdout.

=cut

sub debug_dump {
   my ($self) = @_;
   printf "INFO FOR %s (%s):\n", $self->jid, $self->node;
   for ($self->identities) {
      printf "   ID     : %20s/%-10s (%s)\n", $_->{category}, $_->{type}, $_->{name}
   }
   for (sort keys %{$self->features}) {
      printf "   FEATURE: %s\n", $_;
   }
   print "END ITEMS\n";

}

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
Revision:	1.6
Committed:	Wed Jul 25 13:53:33 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.5:	+1 -1 lines
Log Message:	implemented OOB and fixed bugs in Disco and further developed in band registration.
#	User	Rev	Content
1	elmex	1.2	package Net::XMPP2::Ext::Disco::Info;
2	elmex	1.1	use Net::XMPP2::Namespaces qw/xmpp_ns/;
3
4			=head1 NAME
5
6	elmex	1.6	Net::XMPP2::Ext::Disco::Info - Service discovery info
7	elmex	1.1
8			=head1 SYNOPSIS
9
10			=head1 DESCRIPTION
11
12			This class represents the result of a disco info request
13	elmex	1.2	sent by a C<Net::XMPP2::Ext::Disco> handler.
14	elmex	1.1
15			=head1 METHODS
16
17	elmex	1.3	=over 4
18
19	elmex	1.1	=cut
20
21			sub new {
22			my $this = shift;
23			my $class = ref($this) \|\| $this;
24			my $self = bless { @_ }, $class;
25			$self->init;
26			$self
27			}
28
29	elmex	1.3	=item B<xml_node ()>
30	elmex	1.1
31			Returns the L<Net::XMPP2::Node> object of the IQ query.
32
33			=cut
34
35			sub xml_node {
36			my ($self) = @_;
37			$self->{xmlnode}
38			}
39
40	elmex	1.3	=item B<jid ()>
41	elmex	1.1
42			Returns the JID these items belong to.
43
44			=cut
45
46			sub jid { $_[0]->{jid} }
47
48	elmex	1.3	=item B<node ()>
49	elmex	1.1
50			Returns the node these items belong to (may be undef).
51
52			=cut
53
54			sub node { $_[0]->{node} }
55
56			sub init {
57			my ($self) = @_;
58			my $node = $self->{xmlnode};
59	elmex	1.5	return unless $node;
60	elmex	1.1
61			my (@ids) = $node->find_all ([qw/disco_info identity/]);
62			for (@ids) {
63			push @{$self->{identities}}, {
64			category => $_->attr ('category'),
65			type => $_->attr ('type'),
66			name => $_->attr ('name'),
67			xml_node => $_,
68			};
69			}
70
71			my (@fs) = $node->find_all ([qw/disco_info feature/]);
72			$self->{features}->{$_->attr ('var')} = $_ for @fs;
73
74			}
75
76	elmex	1.3	=item B<identities ()>
77	elmex	1.1
78			Returns a list of hashrefs which contain following keys:
79
80			category, type, name, xml_node
81
82			C<category> is the category of the identity. C<type> is the
83			type of the identity. C<name> is the human readable name of
84			the identity and might be undef. C<xml_node> is the L<Net::XMPP2::Node>
85			object of the <identity/> node.
86
87			C<category> and C<type> may be one of those defined on:
88
89			http://www.xmpp.org/registrar/disco-categories.html
90
91			=cut
92
93			sub identities {
94			my ($self) = @_;
95			@{$self->{identities}}
96			}
97
98	elmex	1.3	=item B<features ()>
99	elmex	1.1
100			Returns a hashref of key/value pairs where the key is the feature name
101			as listed on:
102
103			http://www.xmpp.org/registrar/disco-features.html
104
105			and the value is a L<Net::XMPP2::Node> object for the <feature/> node.
106
107			=cut
108
109			sub features { $_[0]->{features} \|\| {} }
110
111
112	elmex	1.3	=item B<debug_dump ()>
113	elmex	1.1
114			Prints the information of this Info object to stdout.
115
116			=cut
117
118			sub debug_dump {
119			my ($self) = @_;
120			printf "INFO FOR %s (%s):\n", $self->jid, $self->node;
121			for ($self->identities) {
122			printf " ID : %20s/%-10s (%s)\n", $_->{category}, $_->{type}, $_->{name}
123			}
124			for (sort keys %{$self->features}) {
125			printf " FEATURE: %s\n", $_;
126			}
127	elmex	1.3	print "END ITEMS\n";
128	elmex	1.1
129			}
130
131	elmex	1.3	=back
132
133	elmex	1.1	=head1 AUTHOR
134
135	elmex	1.3	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
136	elmex	1.1
137			=head1 COPYRIGHT & LICENSE
138
139			Copyright 2007 Robin Redeker, all rights reserved.
140
141			This program is free software; you can redistribute it and/or modify it
142			under the same terms as Perl itself.
143
144			=cut
145
146			1;