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)
}

=head2 is_bare_jid ($jid)

This method returns a boolean which indicates whether C<$jid> is a 
bare JID.

=cut

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

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.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; # End of Net::XMPP2
Revision:	1.4
Committed:	Fri Feb 9 20:23:06 2007 UTC (19 years, 7 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+0 -38 lines
Log Message:	removed unneccessary documentation and added neglected documentation.
#	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	elmex	1.3	=head2 is_bare_jid ($jid)
153
154			This method returns a boolean which indicates whether C<$jid> is a
155			bare JID.
156
157			=cut
158
159			sub is_bare_jid {
160			my ($jid) = @_;
161			my ($user, $host, $res) = split_jid ($jid);
162			defined $res
163			}
164
165	elmex	1.1	=head1 AUTHOR
166
167			Robin Redeker, C<< <elmex at ta-sa.org> >>
168
169			=head1 COPYRIGHT & LICENSE
170
171			Copyright 2007 Robin Redeker, all rights reserved.
172
173			This program is free software; you can redistribute it and/or modify it
174			under the same terms as Perl itself.
175
176			=cut
177
178			1; # End of Net::XMPP2