File Coverage

blib/lib/AnyEvent/XMPP/Ext/Disco/Info.pm
Criterion Covered Total %
statement 6 36 16.6
branch 0 4 0.0
condition 0 3 0.0
subroutine 2 10 20.0
pod 6 8 75.0
total 14 61 22.9


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