Create custom Moose attribute type

Question

I am trying to simplify the definition of a class of attributes for my Moose classes. For example, consider a class of attributes that can be labeled as private, here is an example of one such attribute:

package MyPkg;
use Moose;

has some_attribute => (
    is       => 'ro',
    isa      => 'Str',
    lazy     => 1,
    init_arg => undef, # prevent from being set by constructor
    builder  => "_set_some_attribute"
);

sub _set_some_attribute {
    my ( $self ) = @_;

    return "value_of_some_attribute";
}

sub some_method_that_uses_some_attribute {
    my ( $self ) = @_;

    return "The value of some attribute: " . $self->some_attribute;
}

package main;

use feature qw(say);
use strict;
use warnings;

my $o = MyPkg->new();    
say $o->some_method_that_uses_some_attribute;

Imagine that the attribute some_attribute of the class MyPkg belongs to a group of attributes that can be labeled private, where all attributes with the type private is for example lazy and cannot be set by the constructor. That is, I would like to simplify:

package MyPkg;
use Moose;
has some_attribute => (
    is       => 'ro',
    isa      => 'Str',
    lazy     => 1,
    init_arg => undef, # prevent from being set by constructor
    builder  => "_set_some_attribute"
);

to something like this

package MyPkg;
use Moose;
use MyMooseAttributeExtensions; # <-- some Moose extension that I have to write
has some_attribute => (is => 'ro', isa => 'Str', private => 1 );

Is this possible with Moose?

Answer 1

According to Moose::Manual::Attribute:

If you have a number of attributes that differ only by name, you can declare them all at once:

package Point;  
use Moose;

has [ 'x', 'y' ] => ( is => 'ro', isa => 'Int' );

Also, because has is just a function call, you can call it in a loop:

for my $name ( qw( x y ) ) {  
    my $builder = '_build_' . $name;  
    has $name => ( is => 'ro', isa => 'Int', builder => $builder );
}

There is also a lazy_build attribute, see Moose::Meta::Attribute, but the documentaion says: "Note that use of this feature is strongly discouraged"

A last option is to use an extension package. I guess this already exists somewhere on CPAN already, but I could not find it, so here is my attempt to implement the Moose extension:

package MyMooseAttributeExtensions;
use strict;
use warnings;

our %orig_has;  # save original 'has' sub routines here

sub import {
    my $callpkg = caller 0;
    {
        no strict 'refs';
        no warnings 'redefine';
        $orig_has{$callpkg} = *{$callpkg."::has"}{CODE};
        *{$callpkg."::has"} = \&private_has;
    }
    return;
}

sub private_has {
    my ($attr, %args) = @_;

    my $callpkg = caller 0;
    if (exists $args{private} ) {
        delete $args{private};
        %args = (
            %args,
            lazy     => 1,
            init_arg => undef, # prevent from being set by constructor
            builder  => "_set_$attr"
        );
    }
    $orig_has{$callpkg}->($attr, %args);
}

1;