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/stringprep_jid split_jid prep_bare_jid/;
our @ISA = qw/Exporter/;

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