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