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/;
require Exporter;
our @EXPORT_OK = qw/resourceprep nodeprep prep_join_jid join_jid
                    split_jid stringprep_jid prep_bare_jid bare_jid
                    is_bare_jid/;
our @ISA = qw/Exporter/;

=head1 NAME

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

=head1 SYNOPSIS

   use Net::XMPP2::Util qw/split_jid/;
   ...

=head1 FUNCTIONS

These functions can be exported if you want:

=over 4

=item B<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'))
}

=item B<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'))
}

=item B<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 ($node ne '') {
      $node = nodeprep ($node);
      return undef unless defined $node;
      $jid .= "$node\@";
   }

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

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

   $jid
}

=item B<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 $node ne '';
   $jid .= $domain;
   $jid .= "/$resource" if $resource ne '';
   $jid
}

=item B<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);
   }
}

=item B<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);
}

=item B<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)
}

=item B<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)
}

=item B<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
}

=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; # End of Net::XMPP2
Revision:	1.7
Committed:	Wed Jul 4 16:05:22 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+20 -12 lines
Log Message:	major documentation refresh. preparing for release
#	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	elmex	1.5	require Exporter;
6	elmex	1.7	our @EXPORT_OK = qw/resourceprep nodeprep prep_join_jid join_jid
7			split_jid stringprep_jid prep_bare_jid bare_jid
8			is_bare_jid/;
9	elmex	1.5	our @ISA = qw/Exporter/;
10	elmex	1.1
11			=head1 NAME
12
13			Net::XMPP2::Util - Utility functions for Net::XMPP2
14
15			=head1 SYNOPSIS
16
17	elmex	1.7	use Net::XMPP2::Util qw/split_jid/;
18	elmex	1.1	...
19
20			=head1 FUNCTIONS
21
22	elmex	1.7	These functions can be exported if you want:
23
24			=over 4
25
26			=item B<resourceprep ($string)>
27	elmex	1.1
28			This function applies the stringprep profile for resources to C<$string>
29			and returns the result.
30
31			=cut
32
33			sub resourceprep {
34			my ($str) = @_;
35			decode_utf8 (idn_prep_resource (encode_utf8 ($str), 'UTF-8'))
36			}
37
38	elmex	1.7	=item B<nodeprep ($string)>
39	elmex	1.1
40			This function applies the stringprep profile for nodes to C<$string>
41			and returns the result.
42
43			=cut
44
45			sub nodeprep {
46			my ($str) = @_;
47			decode_utf8 (idn_prep_node (encode_utf8 ($str), 'UTF-8'))
48			}
49
50	elmex	1.7	=item B<prep_join_jid ($node, $domain, $resource)>
51	elmex	1.1
52			This function joins the parts C<$node>, C<$domain> and C<$resource>
53			to a full jid and applies stringprep profiles. If the profiles couldn't
54			be applied undef will be returned.
55
56			=cut
57
58	elmex	1.2	sub prep_join_jid {
59	elmex	1.1	my ($node, $domain, $resource) = @_;
60			my $jid = "";
61
62	elmex	1.6	if ($node ne '') {
63	elmex	1.1	$node = nodeprep ($node);
64			return undef unless defined $node;
65			$jid .= "$node\@";
66			}
67
68			$domain = $domain; # TODO: apply IDNA!
69			$jid .= $domain;
70
71	elmex	1.6	if ($resource ne '') {
72	elmex	1.1	$resource = resourceprep ($resource);
73			return undef unless defined $resource;
74			$jid .= "/$resource";
75			}
76
77			$jid
78			}
79
80	elmex	1.7	=item B<join_jid ($user, $domain, $resource)>
81	elmex	1.2
82			This is a plain concatenation of C<$user>, C<$domain> and C<$resource>
83			without stringprep.
84
85			See also L<prep_join_jid>
86
87			=cut
88
89			sub join_jid {
90			my ($node, $domain, $resource) = @_;
91			my $jid = "";
92	elmex	1.6	$jid .= "$node\@" if $node ne '';
93	elmex	1.2	$jid .= $domain;
94	elmex	1.6	$jid .= "/$resource" if $resource ne '';
95	elmex	1.2	$jid
96			}
97
98	elmex	1.7	=item B<split_jid ($jid)>
99	elmex	1.2
100			This function splits up the C<$jid> into user/node, domain and resource
101			part and will return them as list.
102
103			my ($user, $host, $res) = split_jid ($jid);
104
105			=cut
106
107			sub split_jid {
108			my ($jid) = @_;
109			if ($jid =~ /^([^@])@?([^\/]+)\/?(.)$/) {
110			return ($1, $2, $3);
111			} else {
112			return (undef, undef, undef);
113			}
114			}
115
116	elmex	1.7	=item B<stringprep_jid ($jid)>
117	elmex	1.1
118			This applies stringprep to all parts of the jid according to the RFC 3920.
119			Use this if you want to compare two jids like this:
120
121			stringprep_jid ($jid_a) eq stringprep_jid ($jid_b)
122
123			This function returns undef if the C<$jid> couldn't successfully be parsed
124			and the preparations done.
125
126			=cut
127
128			sub stringprep_jid {
129			my ($jid) = @_;
130	elmex	1.2	my ($user, $host, $res) = split_jid ($jid);
131			return undef unless defined ($user) \|\| defined ($host) \|\| defined ($res);
132			return prep_join_jid ($user, $host, $res);
133			}
134
135	elmex	1.7	=item B<prep_bare_jid ($jid)>
136	elmex	1.2
137			This function makes the jid C<$jid> a bare jid, meaning:
138			it will strip off the resource part. With stringprep.
139
140			=cut
141
142			sub prep_bare_jid {
143			my ($jid) = @_;
144			my ($user, $host, $res) = split_jid ($jid);
145			prep_join_jid ($user, $host)
146			}
147
148	elmex	1.7	=item B<bare_jid ($jid)>
149	elmex	1.2
150			This function makes the jid C<$jid> a bare jid, meaning:
151			it will strip off the resource part. But without stringprep.
152
153			=cut
154
155			sub bare_jid {
156			my ($jid) = @_;
157			my ($user, $host, $res) = split_jid ($jid);
158			join_jid ($user, $host)
159	elmex	1.1	}
160
161	elmex	1.7	=item B<is_bare_jid ($jid)>
162	elmex	1.3
163			This method returns a boolean which indicates whether C<$jid> is a
164			bare JID.
165
166			=cut
167
168			sub is_bare_jid {
169			my ($jid) = @_;
170			my ($user, $host, $res) = split_jid ($jid);
171			defined $res
172			}
173
174	elmex	1.7	=back
175
176	elmex	1.1	=head1 AUTHOR
177
178	elmex	1.7	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
179	elmex	1.1
180			=head1 COPYRIGHT & LICENSE
181
182			Copyright 2007 Robin Redeker, all rights reserved.
183
184			This program is free software; you can redistribute it and/or modify it
185			under the same terms as Perl itself.
186
187			=cut
188
189			1; # End of Net::XMPP2