Entering MooseX, Part the Sixteenth

Well I really mean it this is I think the last last .t for this module. This time I will be testing the use of my new module as a trait. So here goes

I start with the usual suspects

 
#!perl -T
use strict;
use warnings;

use Test::More tests => 5;
 
use_ok('MooseX::Meta::Method::Role::Authorized');
 {
   package test_role1;
   use Moose::Role;
   has 'nothing_r1 '=> (is => 'ro',default=>'role 1');
   
}
{
   package test_role2;
   use Moose::Role;
   has 'nothing_r2' => (is => 'ro',default=>'role 2');
   
}
{
   package test_role3;
   use Moose::Role;
   has 'nothing_r3' => (is => 'ro',default=>'role 3');
   
}


The testing boiler-plate and my three little test roles. Now I take a different tack on things (well at least the original programmer did as I really just lifted this from his test)

 
use Moose;
my $method_metaclass = Moose::Meta::Class->create_anon_class
  (
   superclasses => ['Moose::Meta::Method'],
   roles => ['MooseX::Meta::Method::Role::Authorized'],
   cache => 1,
  );


and I create a little 'anonymous class' that I can use later on to add a role on the fly or as many like to call it a 'Trait' and it imports the core role of this Mod 'MooseX::Meta::Method::Role::Authorized'.

Next I create my testing class and this time out I just need one to test the full API and here goes

 
{ package test_all_pass_fail;
  use Moose;
  with ('test_role1','test_role3');
  
  my $m = $method_metaclass->name->wrap
    (
     sub {
         my $self = shift;
         return ' required_pass '.shift;
     },
     package_name => 'test_all_pass_fail',
     name => 'ping_required_pass',
     requires =>{ required =>['test_role3']}
    );
  __PACKAGE__->meta->add_method('ping_required_pass',$m);
 
  my $n = $method_metaclass->name->wrap
    (
     sub {
         my $self = shift;
         return 'one_of_pass'.shift;
     },
     package_name => 'test_all_pass_fail',
     name => 'ping_one_of_pass',
     requires =>{ one_of =>['test_role1','test_role2']}
    );
  __PACKAGE__->meta->add_method('ping_one_of_pass',$n);
 
 
  my $o = $method_metaclass->name->wrap
    (
     sub {
         my $self = shift;
         return ' one_of_fail '.shift;
     },
     package_name => 'test_all_pass_fail',
     name => 'ping_one_of_fail',
     requires =>{ one_of =>['test_role2','test_role4']}
    );
  __PACKAGE__->meta->add_method('ping_one_of_fail',$o);
  
  my $p = $method_metaclass->name->wrap
    (
     sub {
         my $self = shift;
         return ' required_fail '.shift;
     },
     package_name => 'test_all_pass_fail',
     name => 'ping_required_fail',
     requires =>{ required =>['test_role2']}
    );
  __PACKAGE__->meta->add_method('ping_required_fail',$p);

};

Now what am I doing here. Well it is the same pattern a few times over so I will just explain the first one, and yes this would qualify as an anti-pattern but it is just a .t file.

Well I first add in two of my test roles I will use with a 'with' next I use that new 'Trait' and use its wrap function to add its role to my 'anonymous sub', next the package name, the Sub name and finally the requires that contains my API part. I then add what is returned from the wrap fall to the current package with the meta->add_method with the same name as I used in my wrap call.

The funny thing this is almost the opposite calling sequence when just using it as part of a class like this

 
 authorized_roles ping =>  { required =>['test_role1']}, sub {
      return "ping test_required_pass";
   };


just something I noticed,

Anyway my test are quite simple again just create an instance of my class and test the sub calls like this

 
my $object1 = test_all_pass_fail->new();
 
ok($object1->ping_required_pass('test1'),'ping_required_pass');
ok($object1->ping_one_of_pass('test1'),'ping_one_of_pass');

eval {
  $object1->ping_one_of_fail('test1');
};

ok(scalar($@),"ping_one_of_fail pass");

eval {
  $object1->ping_required_fail('test1');
};

ok(scalar($@),"ping_required_fail pass");

and I give it a go and first time I get

 

D:\Blogs\Moosex-AuthorizedMethodRoles\t\50-Trait.t .. 
1..5
ok 1 - use MooseX::Meta::Method::Role::Authorized;
ok 2 - ping_required_pass
ok 3 - ping_one_of_pass
ok 4 - ping_one_of_fail pass
ok 5 - ping_required_fail pass
ok
All tests successful.
Files=1, Tests=5,  0 wallclock secs ( 0.05 usr +  0.00 sys =  0.05 CPU)
Result: PASS

Gee I think I am beginning to get good at this :), And now I think that give me 100% coverage?

antlerbanter.jpg

Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations