Moose coercion to file-permission octal value

94 views Asked by At

In my Moose object need manage file-permission attribute. Would be nice to accept, any variant, e.g:

my $obj = My::Obj->new();   # should assign default 0444
my $obj = My::Obj->new(perm => '1666'); #as string
my $obj = My::Obj->new(perm => 0555); #as octal

also verifies the value when it is set by the accessor, like:

$obj->perm('0666');
#etc

So, looking for something

has 'perm' => (is => 'rw', isa => Perm, coerce => 1, default => sub { oct('0444') });

e.g. want store the permission as an number (what is usable in the file-operations).

but have no idea how to create the Perm type, what

  • dies on incorrect values
  • coerces from valid string to octal value
  • accepts valid octal value

e.g. tried something like

subtype 'Perm',
    as 'Str',  #but i want store a number 
    where { $_ =~ /\A[01246]?[0-7]{3}\z/ };  #but i know the validation for strings only

But the above verifies it as Str and I want store the octal value, so I'm lost.. ;(

Could anyone help?

EDIT

Still fighting with this.

package Some;
use 5.018;
use warnings;
use namespace::sweep;
use Moose;
use Moose::Util::TypeConstraints;

subtype 'Perm', as 'Int', where { $_ >= 0 and $_ <= 06777 }, message { 'octal perm out of range' };
subtype 'PermStr', as 'Str', where { $_ =~ /\A[01246]?[0-7]{3}\z/ }, message { 'bad string-perm' };
coerce 'Perm', from 'PermStr', via { oct("$_") };

has 'perm' => ( is => 'rw', isa => 'Perm', coerce => 1, default => 0444, );
no Moose::Util::TypeConstraints;

package main;
my($p,$q);
$p = '0333' ; $q = Some->new(perm => $p); printf("dec:%d oct:%o\n", $q->perm, $q->perm);
$p = '0383' ; $q = Some->new(perm => $p); printf("dec:%d oct:%o\n", $q->perm, $q->perm);
$p =   0333 ; $q = Some->new(perm => $p); printf("dec:%d oct:%o\n", $q->perm, $q->perm);
$p = 033333 ; $q = Some->new(perm => $p); printf("dec:%d oct:%o\n", $q->perm, $q->perm);

the above prints:

dec:333 oct:515
dec:383 oct:577
dec:219 oct:333
Attribute (perm) does not pass the type constraint because: octal perm out of range at ....

E.g. the perm entered as octal works (and detects the out of range), but from the string

  • doesn't checks the match
  • and it doesn't does the octal conversion.
1

There are 1 answers

3
cjm On

Try something like this:

subtype 'Perm',
    as 'Int',
    where { $_ >= 0 and $_ <= 06777 };

subtype 'PermStr',
    as 'Str',
    where { $_ =~ /\A[01246]?[0-7]{3}\z/ };

coerce 'Perm',
  from 'PermStr',
  via { oct($_) };

Don't forget to declare your attributes with coerce => 1.

Note: The where clause I gave for Perm is less restrictive than the one you gave for PermStr. Changing it to disallow 03000–03777 and 05000–05777 is an exercise left for the reader.