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 )