File Coverage

blib/lib/Net/XMPP/JID.pm

Criterion	Covered	Total	%
statement	44	80	55.0
branch	14	32	43.7
condition	2	15	13.3
subroutine	9	15	60.0
pod	6	12	50.0
total	75	154	48.7

##############################################################################
#
#  This library is free software; you can redistribute it and/or
#  modify it under the terms of the GNU Library General Public
#  License as published by the Free Software Foundation; either
#  version 2 of the License, or (at your option) any later version.
#
#  This library is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  Library General Public License for more details.
#
#  You should have received a copy of the GNU Library General Public
#  License along with this library; if not, write to the
#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA  02111-1307, USA.
#
#  Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
#
##############################################################################

package Net::XMPP::JID;

=head1 NAME

Net::XMPP::JID - XMPP JID Module

=head1 SYNOPSIS

Net::XMPP::JID is a companion to the Net::XMPP module.
It provides the user a simple interface to set and retrieve all
parts of a Jabber ID (userid on a server).

=head1 DESCRIPTION

To initialize the JID you must pass it the string that represents the
jid from the XML packet.  Inside the XMPP modules this is done
automatically and the JID object is returned instead of a string.
For example, in the callback function for the XMPP object foo:

    use Net::XMPP;

    sub foo {
      my $foo = Net::XMPP::Foo->new(@_);
      my $from = $foo->GetFrom();
      my $JID = Net::XMPP::JID->new($from);
      .
      .
      .
    }

You now have access to all of the retrieval functions available.

To create a new JID to send to the server:

    use Net::XMPP;

    $JID = Net::XMPP::JID->new();

Now you can call the creation functions below to populate the tag
before sending it.

=head2 Retrieval functions

    $userid   = $JID->GetUserID();
    $server   = $JID->GetServer();
    $resource = $JID->GetResource();

    $JID      = $JID->GetJID();
    $fullJID  = $JID->GetJID("full");
    $baseJID  = $JID->GetJID("base");

=head2 Creation functions

    $JID->SetJID(userid=>"bob",
                 server=>"jabber.org",
                 resource=>"Work");

    $JID->SetJID('[e-mail]/Home');

    $JID->SetUserID("foo");
    $JID->SetServer("bar.net");
    $JID->SetResource("Foo Bar");

=head1 METHODS

=head2 Retrieval functions

=over 4

=item GetUserID

  GetUserID()

returns a string with the userid of the JID.
If the string is an address (bob%jabber.org) then
the function will return it as an address
([e-mail]).

=item GetServer

  GetServer()

returns a string with the server of the JID.

=item GerResource

  GetResource()

returns a string with the resource of the JID.

=item GetJID

  GetJID()
  GetJID("full")
  GetJID("base")
returns a string that represents the JID stored
within.  If the "full" string is specified, then
you get the full JID, including Resource, which
should be used to send to the server.  If the "base",
string is specified, then you will just get
user@server, or the base JID.

=back

=head2 Creation functions

=over 4

=item SetJID

  SetJID(userid=>string,
         server=>string,
         resource=>string)
  SetJID(string)

set multiple fields in the jid at
one time.  This is a cumulative
and over writing action.  If you set
the "userid" attribute twice, the second
setting is what is used.  If you set
the server, and then set the resource
then both will be in the jid.  If all
you pass is a string, then that string
is used as the JID.  For valid settings
read the specific Set functions below.

=item SetUserID

  SetUserID(string)

sets the userid.  Must be a valid userid or the
server will complain if you try to use this JID
to talk to the server.  If the string is an
address then it will be converted to the %
form suitable for using as a User ID.

=item SerServer

  SetServer(string)

sets the server.  Must be a valid host on the
network or the server will not be able to talk
to it.

=item SetResource

  SetResource(string)

sets the resource of the userid to talk to.

=back

=head1 AUTHOR

Originally authored by Ryan Eatmon.

Previously maintained by Eric Hacker.

Currently maintained by Darian Anthony Patrick.

=head1 COPYRIGHT

This module is free software, you can redistribute it and/or modify it
under the LGPL 2.1.

=cut

require 5.008;
use strict;
use warnings;
use Carp;

sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = { };

    bless($self, $proto);

    if ("@_" ne (""))
    {
        my ($jid) = @_;
        return $jid if ((ref($jid) ne "") && ($jid->isa("Net::XMPP::JID")));
        $self->{JID} = $jid;
    }
    else
    {
        $self->{JID} = "";
    }
    $self->ParseJID();

    return $self;
}


##############################################################################
#
# ParseJID - private helper function that takes the JID and sets the
#            the three parts of it.
#
##############################################################################
sub ParseJID
{
    my $self = shift;

    my $userid;
    my $server;
    my $resource;

    ($userid,$server,$resource) =
        ($self->{JID} =~ /^([^\@\/'"&:<>]*)\@([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
    if (!defined($server))
    {
        ($server,$resource) =
            ($self->{JID} =~ /^([A-Za-z0-9\.\-\_]+)\/?(.*?)$/);
    }

    $userid = "" unless defined($userid);
    $server = "" unless defined($server);
    $resource = "" unless defined($resource);

    $self->{USERID} = $userid;
    $self->{SERVER} = $server;
    $self->{RESOURCE} = $resource;
}


##############################################################################
#
# BuildJID - private helper function that takes the three parts and sets the
#            JID from them.
#
##############################################################################
sub BuildJID
{
    my $self = shift;
    $self->{JID} = $self->{USERID};
    $self->{JID} .= "\@" if ($self->{USERID} ne "");
    $self->{JID} .= $self->{SERVER} if (exists($self->{SERVER}) &&
                        defined($self->{SERVER}));
    $self->{JID} .= "/".$self->{RESOURCE} if (exists($self->{RESOURCE}) &&
                        defined($self->{RESOURCE}) &&
                        ($self->{RESOURCE} ne ""));
}


##############################################################################
#
# GetUserID - returns the userid of the JID.
#
##############################################################################
sub GetUserID
{
    my $self = shift;
    my $userid = $self->{USERID};
    $userid =~ s/\%/\@/;
    return $userid;
}


##############################################################################
#
# GetServer - returns the server of the JID.
#
##############################################################################
sub GetServer
{
    my $self = shift;
    return $self->{SERVER};
}


##############################################################################
#
# GetResource - returns the resource of the JID.
#
##############################################################################
sub GetResource
{
    my $self = shift;
    return $self->{RESOURCE};
}


##############################################################################
#
# GetJID - returns the full jid of the JID.
#
##############################################################################
sub GetJID
{
    my $self = shift;
    my $type = shift;
    $type = "" unless defined($type);
    return $self->{JID} if ($type eq "full");
    return $self->{USERID}."\@".$self->{SERVER} if ($self->{USERID} ne "");
    return $self->{SERVER};
}


##############################################################################
#
# SetJID - takes a hash of all of the things you can set on a JID and sets
#          each one.
#
##############################################################################
sub SetJID
{
    my $self = shift;
    my %jid;

    if ($#_ > 0 ) {
        while($#_ >= 0) { $jid{ lc pop(@_) } = pop(@_); }

        $self->SetUserID($jid{userid}) if exists($jid{userid});
        $self->SetServer($jid{server}) if exists($jid{server});
        $self->SetResource($jid{resource}) if exists($jid{resource});
    } else {
        ($self->{JID}) = @_;
        $self->ParseJID();
    }
}


##############################################################################
#
# SetUserID - sets the userid of the JID.
#
##############################################################################
sub SetUserID
{
    my $self = shift;
    my ($userid) = @_;
    $userid =~ s/\@/\%/;
    $self->{USERID} = $userid;
    $self->BuildJID();
}


##############################################################################
#
# SetServer - sets the server of the JID.
#
##############################################################################
sub SetServer
{
    my $self = shift;
    my ($server) = @_;
    $self->{SERVER} = $server;
    $self->BuildJID();
}


##############################################################################
#
# SetResource - sets the resource of the JID.
#
##############################################################################
sub SetResource
{
    my $self = shift;
    my ($resource) = @_;
    $self->{RESOURCE} = $resource;
    $self->BuildJID();
}


##############################################################################
#
# debug - prints out the contents of the JID
#
##############################################################################
sub debug
{
    my $self = shift;

    print "debug JID: $self\n";
    print "UserID:   (",$self->{USERID},")\n";
    print "Server:   (",$self->{SERVER},")\n";
    print "Resource: (",$self->{RESOURCE},")\n";
    print "JID:      (",$self->{JID},")\n";
}


1;