Net/XMPP2/Util.pm

package Net::XMPP2::Util;
use strict;
use Encode;
use Net::LibIDN qw/idn_prep_name idn_prep_resource idn_prep_node/;

=head1 NAME

Net::XMPP2::Util - Utility functions for Net::XMPP2

=head1 SYNOPSIS

   use Net::XMPP2::Util;
   ...

=head1 FUNCTIONS

=head2 resourceprep ($string)

This function applies the stringprep profile for resources to C<$string>
and returns the result.

=cut

sub resourceprep {
   my ($str) = @_;
   decode_utf8 (idn_prep_resource (encode_utf8 ($str), 'UTF-8'))
}

=head2 nodeprep ($string)

This function applies the stringprep profile for nodes to C<$string>
and returns the result.

=cut

sub nodeprep {
   my ($str) = @_;
   decode_utf8 (idn_prep_node (encode_utf8 ($str), 'UTF-8'))
}

=head2 prep_join_jid ($node, $domain, $resource)

This function joins the parts C<$node>, C<$domain> and C<$resource>
to a full jid and applies stringprep profiles. If the profiles couldn't
be applied undef will be returned.

=cut

sub prep_join_jid {
   my ($node, $domain, $resource) = @_;
   my $jid = "";

   if (defined $node) {
      $node = nodeprep ($node);
      return undef unless defined $node;
      $jid .= "$node\@";
   }

   $domain = $domain; # TODO: apply IDNA!
   $jid .= $domain;

   if (defined $resource) {
      $resource = resourceprep ($resource);
      return undef unless defined $resource;
      $jid .= "/$resource";
   }

   $jid
}

=head2 join_jid ($user, $domain, $resource)

This is a plain concatenation of C<$user>, C<$domain> and C<$resource>
without stringprep.

See also L<prep_join_jid>

=cut

sub join_jid {
   my ($node, $domain, $resource) = @_;
   my $jid = "";
   $jid .= "$node\@" if defined $node;
   $jid .= $domain;
   $jid .= "/$resource" if defined $resource;
   $jid
}

=head2 split_jid ($jid)

This function splits up the C<$jid> into user/node, domain and resource
part and will return them as list.

   my ($user, $host, $res) = split_jid ($jid);

=cut

sub split_jid {
   my ($jid) = @_;
   if ($jid =~ /^([^@]*)@?([^\/]+)\/?(.*)$/) {
      return ($1, $2, $3);
   } else {
      return (undef, undef, undef);
   }
}

=head2 stringprep_jid ($jid)

This applies stringprep to all parts of the jid according to the RFC 3920.
Use this if you want to compare two jids like this:

   stringprep_jid ($jid_a) eq stringprep_jid ($jid_b)

This function returns undef if the C<$jid> couldn't successfully be parsed
and the preparations done.

=cut

sub stringprep_jid {
   my ($jid) = @_;
   my ($user, $host, $res) = split_jid ($jid);
   return undef unless defined ($user) || defined ($host) || defined ($res);
   return prep_join_jid ($user, $host, $res);
}

=head2 prep_bare_jid ($jid)

This function makes the jid C<$jid> a bare jid, meaning:
it will strip off the resource part. With stringprep.

=cut

sub prep_bare_jid {
   my ($jid) = @_;
   my ($user, $host, $res) = split_jid ($jid);
   prep_join_jid ($user, $host)
}

=head2 bare_jid ($jid)

This function makes the jid C<$jid> a bare jid, meaning:
it will strip off the resource part. But without stringprep.

=cut

sub bare_jid {
   my ($jid) = @_;
   my ($user, $host, $res) = split_jid ($jid);
   join_jid ($user, $host)
}

=head1 AUTHOR

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

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::XMPP2

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-XMPP2>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-XMPP2>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-XMPP2>

=back

=head1 ACKNOWLEDGEMENTS

=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; # End of Net::XMPP2
Revision:	1.2
Committed:	Tue Feb 6 22:52:45 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+67 -8 lines
Log Message:	implemented firts parts of roster handling. added jid handling functions.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Util;
2			use strict;
3			use Encode;
4			use Net::LibIDN qw/idn_prep_name idn_prep_resource idn_prep_node/;
5
6			=head1 NAME
7
8			Net::XMPP2::Util - Utility functions for Net::XMPP2
9
10			=head1 SYNOPSIS
11
12			use Net::XMPP2::Util;
13			...
14
15			=head1 FUNCTIONS
16
17			=head2 resourceprep ($string)
18
19			This function applies the stringprep profile for resources to C<$string>
20			and returns the result.
21
22			=cut
23
24			sub resourceprep {
25			my ($str) = @_;
26			decode_utf8 (idn_prep_resource (encode_utf8 ($str), 'UTF-8'))
27			}
28
29			=head2 nodeprep ($string)
30
31			This function applies the stringprep profile for nodes to C<$string>
32			and returns the result.
33
34			=cut
35
36			sub nodeprep {
37			my ($str) = @_;
38			decode_utf8 (idn_prep_node (encode_utf8 ($str), 'UTF-8'))
39			}
40
41	elmex	1.2	=head2 prep_join_jid ($node, $domain, $resource)
42	elmex	1.1
43			This function joins the parts C<$node>, C<$domain> and C<$resource>
44			to a full jid and applies stringprep profiles. If the profiles couldn't
45			be applied undef will be returned.
46
47			=cut
48
49	elmex	1.2	sub prep_join_jid {
50	elmex	1.1	my ($node, $domain, $resource) = @_;
51			my $jid = "";
52
53			if (defined $node) {
54			$node = nodeprep ($node);
55			return undef unless defined $node;
56			$jid .= "$node\@";
57			}
58
59			$domain = $domain; # TODO: apply IDNA!
60			$jid .= $domain;
61
62			if (defined $resource) {
63			$resource = resourceprep ($resource);
64			return undef unless defined $resource;
65			$jid .= "/$resource";
66			}
67
68			$jid
69			}
70
71	elmex	1.2	=head2 join_jid ($user, $domain, $resource)
72
73			This is a plain concatenation of C<$user>, C<$domain> and C<$resource>
74			without stringprep.
75
76			See also L<prep_join_jid>
77
78			=cut
79
80			sub join_jid {
81			my ($node, $domain, $resource) = @_;
82			my $jid = "";
83			$jid .= "$node\@" if defined $node;
84			$jid .= $domain;
85			$jid .= "/$resource" if defined $resource;
86			$jid
87			}
88
89			=head2 split_jid ($jid)
90
91			This function splits up the C<$jid> into user/node, domain and resource
92			part and will return them as list.
93
94			my ($user, $host, $res) = split_jid ($jid);
95
96			=cut
97
98			sub split_jid {
99			my ($jid) = @_;
100			if ($jid =~ /^([^@])@?([^\/]+)\/?(.)$/) {
101			return ($1, $2, $3);
102			} else {
103			return (undef, undef, undef);
104			}
105			}
106
107	elmex	1.1	=head2 stringprep_jid ($jid)
108
109			This applies stringprep to all parts of the jid according to the RFC 3920.
110			Use this if you want to compare two jids like this:
111
112			stringprep_jid ($jid_a) eq stringprep_jid ($jid_b)
113
114			This function returns undef if the C<$jid> couldn't successfully be parsed
115			and the preparations done.
116
117			=cut
118
119			sub stringprep_jid {
120			my ($jid) = @_;
121	elmex	1.2	my ($user, $host, $res) = split_jid ($jid);
122			return undef unless defined ($user) \|\| defined ($host) \|\| defined ($res);
123			return prep_join_jid ($user, $host, $res);
124			}
125
126			=head2 prep_bare_jid ($jid)
127
128			This function makes the jid C<$jid> a bare jid, meaning:
129			it will strip off the resource part. With stringprep.
130
131			=cut
132
133			sub prep_bare_jid {
134			my ($jid) = @_;
135			my ($user, $host, $res) = split_jid ($jid);
136			prep_join_jid ($user, $host)
137			}
138
139			=head2 bare_jid ($jid)
140
141			This function makes the jid C<$jid> a bare jid, meaning:
142			it will strip off the resource part. But without stringprep.
143
144			=cut
145
146			sub bare_jid {
147			my ($jid) = @_;
148			my ($user, $host, $res) = split_jid ($jid);
149			join_jid ($user, $host)
150	elmex	1.1	}
151
152			=head1 AUTHOR
153
154			Robin Redeker, C<< <elmex at ta-sa.org> >>
155
156			=head1 BUGS
157
158			Please report any bugs or feature requests to
159			C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
160			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
161			I will be notified, and then you'll automatically be notified of progress on
162			your bug as I make changes.
163
164			=head1 SUPPORT
165
166			You can find documentation for this module with the perldoc command.
167
168			perldoc Net::XMPP2
169
170			You can also look for information at:
171
172			=over 4
173
174			=item * AnnoCPAN: Annotated CPAN documentation
175
176			L<http://annocpan.org/dist/Net-XMPP2>
177
178			=item * CPAN Ratings
179
180			L<http://cpanratings.perl.org/d/Net-XMPP2>
181
182			=item * RT: CPAN's request tracker
183
184			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>
185
186			=item * Search CPAN
187
188			L<http://search.cpan.org/dist/Net-XMPP2>
189
190			=back
191
192			=head1 ACKNOWLEDGEMENTS
193
194			=head1 COPYRIGHT & LICENSE
195
196			Copyright 2007 Robin Redeker, all rights reserved.
197
198			This program is free software; you can redistribute it and/or modify it
199			under the same terms as Perl itself.
200
201			=cut
202
203			1; # End of Net::XMPP2