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; |