view release on metacpan or  search on metacpan

t/TCLI.User.t  view on Meta::CPAN

#!/usr/bin/env perl
# $Id: TCLI.User.t 40 2007-04-01 01:56:43Z hacker $

use Test::More qw(no_plan);
use lib 'blib/lib';

# TASK Test suite is not complete. Need testing for catching errors.
BEGIN {
    use_ok('Agent::TCLI::User');
}

#use warnings;
#use strict;

sub user1 {
	my $user1 = Agent::TCLI::User->new({
		'id'		=> 'user1@example.com',
		'protocol'	=> 'jabber',
		'auth'		=> 'read only',
		'verbose'	=> 0,
		'do_verbose'=> sub { diag(@_); },
	});
	return $user1;
}

my $user1 = user1();

is(ref($user1),'Agent::TCLI::User','new user1 object');

my $user2 = Agent::TCLI::User->new(
		'verbose'	=> 0,
		'do_verbose'=> sub { diag(@_); },
);

is(ref($user2),'Agent::TCLI::User', 'new user2 object' );

ok($user2->id('user2@example.com'), '$user2->id set' );
is($user2->id,'user2@example.com' , '$user2->id get' );

ok($user2->protocol('email'), '$user2->protocol set' );
is($user2->protocol,'email' , '$user2->protocol get' );

ok($user2->auth('master'), '$user2->auth set' );
is($user2->auth,'master' , '$user2->auth get' );

# Test name get methods
is($user1->get_name,'user1','$user1->get_name from init');
is($user2->get_name,'user2','$user2->get_name from id set');

# Test domain get methods
is($user1->get_domain,'example.com','$user1->get_domain from init');
is($user2->get_domain,'example.com','$user2->get_domain from id set');

# user is authorized
#not_authorized ( { id	   =>  value,   # user id. Will strip off resource
#				  protocol =>  qr(jabber),   # optional regex for protocol
#				  auth	   =>  qr(master|writer),   # option regex for auth
#				} );

ok( !$user1->not_authorized(
				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
				  auth	   =>  qr(read only),   # option regex for auth
				}), 'user1 not_authorized no protocol' );
ok( !$user1->not_authorized(
				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				}), 'user1 not_authorized no auth' );