Agent-TCLI

 view release on metacpan or  search on metacpan

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

				  msg	   =>  'user1 multiple auths',
				},
				{ id	   =>  'user1@xample.com',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				  auth	   =>  qr(read only),   # option regex for auth
				  user1	   => 'This is not me',
				  user2	   => 'This is not me',
				  msg	   =>  'user1 domain wrong',
				},
				{ id	   =>  'user1@example.com\resource',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				  auth	   =>  qr(read only),   # option regex for auth
				  user1	   => 'This is not me',
				  user2	   => 'This is not me',
				  msg	   =>  'user1 bad resource',
				},
				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
				  protocol =>  qr(email),   		# optional regex for protocol
				  auth	   =>  qr(read only),   # option regex for auth
				  user1	   => 'Improper protocol',
				  user2	   => 'This is not me',
				  msg	   =>  'user1 wrong protocols',
				},
				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				  auth	   =>  qr(master),   # option regex for auth
				  user1	   => 'Inadequate authorization',
				  user2	   => 'This is not me',
				  msg	   =>  'user1 wrong auths',
				},
				{ id	   =>  'theuser1@example.com',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				  auth	   =>  qr(master),   # option regex for auth
				  user1	   => 'This is not me',
				  user2	   => 'This is not me',
				  msg	   =>  'user1 not theuser1',
				},
				{ id	   =>  'user2@example.com',   # user id. Will strip off resource
				  protocol =>  qr(jabber),   		# optional regex for protocol
				  auth	   =>  qr(master),   # option regex for auth
				  user1	   => 'This is not me',
				  user2	   => 'Improper protocol',
				  msg	   =>  'user1 not user2',
				},
);

foreach my $hash ( @auths ) {

like( $user1->not_authorized(
				{ id	   =>  $hash->{'id'},   # user id. Will strip off resource
				  protocol =>  $hash->{'protocol'},   		# optional regex for protocol
				  auth	   =>  $hash->{'auth'},   # option regex for auth
				}), qr($hash->{'user1'}) , 'user1 not_auth against '.$hash->{'msg'} );
like( $user2->not_authorized(
				{ id	   =>  $hash->{'id'},   # user id. Will strip off resource
				  protocol =>  $hash->{'protocol'},   		# optional regex for protocol
				  auth	   =>  $hash->{'auth'},   # option regex for auth
				}), qr($hash->{'user2'}), 'user2 not_auth against '.$hash->{'msg'} );
} #end foreach auths

# This crashes. Apparently Params::Validate on fail doesn't capture it.
#ok(  $user1->not_authorized(
#				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
#				  protocol =>  qr(jabber),   		# optional regex for protocol
#				  auth	   =>  qr(read only),   # option regex for auth
#				  msg	   =>  'user1',
#				}), 'user1 exact but with extra param' );






( run in 1.331 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )