byterock

Well in my last post I managed to de-break my Perl by creating that was for all intensive purposes justa rename and a little rejigged clone of MooseX::Authorized Methods

So onto making this into something that I want.

Well might as well start at the beginning 'MooseX::AuthorizedMethodRoles'

So It starts with

 

package MooseX::AuthorizedMethodRoles;

use Moose ();

use Moose::Exporter;

use aliased 'MooseX::Meta::Method::Role::Authorized';

use Sub::Name;


our $VERSION = 0.006;

Moose::Exporter->setup_import_methods

  ( with_meta => [ 'authorized_roles' ],

    also      => [ 'Moose' ],

  );



my $method_metaclass = Moose::Meta::Class->create_anon_class

  (

   superclasses => ['Moose::Meta::Method'],

   roles => [ Authorized ],

   cache => 1,

  );

Not much needs changing there but I will change the Version over to 0.01 and I am not a big fan of 'aliased' in this sort of class as this is normally code where you would not be poking about on a day to day basis (unless you are like me and enjoy this type of pain) so I will drop that. As well I like to write and use code from CPAN that has as few dependencies as possible, unlike our good friend at Catalyst who seem to thrive on them, I do love that new meta::cpan wheel of misfortune ;)

Now the next part

 


sub authorized_roles {

    my ($meta, $name, $requires, $code, %extra_options) = @_;

    my $m = $method_metaclass->name->wrap

      (

       subname(join('::',$meta->name,$name),$code),

       package_name => $meta->name,

       name => $name,

       requires => $requires,

       %extra_options,

      );

    $meta->add_method($name, $m);

}

1;

So here I see there is an 'extra_options' section I think I will drop that as well as my code is much more specific and at the same time generic, i.e. I am testing for Moose::Roles but I do not need a 'User' or other object with a 'Roles' array.

So the second cut looks like this

 
package MooseX::AuthorizedMethodRoles;
use Moose ();
use Moose::Exporter;
use Sub::Name;

our $VERSION = 0.01;

Moose::Exporter->setup_import_methods

  ( with_meta => [ 'authorized_roles' ],

    also      => [ 'Moose' ],

  );



my $method_metaclass = Moose::Meta::Class->create_anon_class

  (

   superclasses => ['Moose::Meta::Method'],

   roles => [ 'MooseX::Meta::Method::Role::Authorized' ],

   cache => 1,

  );

sub authorized_roles {

    my ($meta, $name, $requires, $code) = @_;

    my $m = $method_metaclass->name->wrap

      (

       subname(join('::',$meta->name,$name),$code),

       package_name => $meta->name,

       name => $name,

       requires => $requires

      );

    $meta->add_method($name, $m);

}

1;

and I rerun my code from the other day and it is still working so a good days work so far.

Now one thing I noticed is I still have a 'use Sub::Name;' in there that is used here

 

   subname(join('::',$meta->name,$name),$code),

Which tacks on the package name to the passed in name and then points that name to the code

So for this snippet

 

package Product::Moves;

use MooseX::AuthorizedMethodRoles;

...

authorized_roles bin_swap =>  [qw(Product::BRULE::Bin ], sub {

...

My the code ref in the 'bin_swap' sub ref will become ' Product::Moves::bin_swap'

Not sure if I can get rid of this as well as at some point I know I will have to play with the 'glob-assignment' to get this to work against an instance so why not do it early on or not at all??

Well we will play with that later.