You may infer from the question that this is my first Moose class.
How do I set an attribute FileHandle to *STDOUT?
This doesn't work.
has 'output' => (
is => 'rw',
isa => 'FileHandle',
default => sub { openhandle(*STDOUT) }
);
The output when run is:
Attribute (output) does not pass the type constraint because: Validation failed for 'FileHandle' with value *main::STDOUT
The documentation claims:
FileHandle accepts either an IO::Handle object or a builtin perl
filehandle (see "openhandle" in Scalar::Util).
What am I missing?
Thanks.
-E
I don't know what else you may need there, but this works for starters
The WithFH.pm
package WithFH;
use feature 'say';
use Moose;
has 'fh' => (is => 'ro', isa => 'FileHandle', default => sub { \*STDOUT } );
sub say {
my $self = shift;
say { $self->{fh} } "#_";
}
__PACKAGE__->meta->make_immutable;
1;
and the main
use warnings;
use strict;
use feature 'say';
use WithFH;
my $wfh = WithFH->new;
$wfh->say("hi");
That prints hi to STDOUT.
Related
For the life of me I can't figure out why this is not working the way the documentation says it should. I have Googled the problem SO searched, looked at the source, etc. Is this a bug or am I doing something wrong that I just can't see.
Here is the code:
#!/usr/bin/env perl
use strict;
use warnings;
package Model;
use Moo::Role;
has ObjectID => (
is => 'rw'
);
package Object;
use Moo;
use namespace::clean;
has model => (
is => 'rw',
handles => 'Model'
);
package main;
my $xo = Object->new;
$xo->ObjectID(12345);
exit;
attempt to run
perl -MCarp::Always t/moohandles.t
and get this
Attempted to access 'model' but it is not set at (eval 26) line 20.
Object::_assert_model('Object=HASH(0x1dfd118)') called at (eval 25) line 17
Object::ObjectID('Object=HASH(0x1dfd118)', 12345) called at t/moohandles.t line 27
Delegation essentially expands the $xo->ObjectID method call to $xo->model->ObjectID. But $xo->model is currently unset. You probably want to default it to an object that consumes the Model role.
Something like this:
use strict;
use warnings;
{
package Model;
use Moo::Role;
has ObjectID => (
is => 'rw',
);
}
{
package ModelClass;
use Moo;
with 'Model';
}
{
package Object;
use Moo;
has model => (
is => 'rw',
handles => 'Model',
builder => sub { ModelClass->new },
);
}
my $xo = Object->new;
$xo->ObjectID(12345);
print $xo->ObjectID, "\n";
Now have:
has 'id' => (
is => 'rw',
isa => 'Str',
default => sub { "id" . int(rand(1000))+1 }
);
Works OK, the:
PKG->new(id => 'some'); #the id is "some"
PKG->new() #the id is #id<random_number>
In the next scenario:
my $value = undef;
PKG->new(id => $value);
(of course) got an error:
Attribute (id) does not pass the type constraint because: Validation failed for 'Str' with value undef at /Users/me/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/darwin-thread-multi-2level/Moose/Exception.pm line 37
The question is:
How to achieve changing the value after it is set to undef (and only when it is $undef)? So,
has 'id' => (
is => 'rw',
isa => 'Str|Undef', #added undef to acceptable Type
default => sub { "id" . int(rand(1000))+1 }
);
Now, it accepting the $undef, but I don't want $undef but want "id" . int(rand(1000))+1. How to change the attribute value after it is set?
The after is called only for the accessors not for constructors. Maybe some weird coercion from Undef to Str - but only for this one attribute?
Ps: using the PKG->new( id => $value // int(rand(10000)) ) is not an acceptable solution. The module should accept the $undef and should silently change it to the random number.
Type::Tiny has as one of its aims to make it easy to add coercions to individual attributes really easy. Here's an example:
use strict;
use warnings;
{
package Local::Test;
use Moose;
use Types::Standard qw( Str Undef );
my $_id_default = sub { "id" . int(rand(1000)+1) };
has id => (
is => 'rw',
isa => Str->plus_coercions(Undef, $_id_default),
default => $_id_default,
coerce => 1,
);
__PACKAGE__->meta->make_immutable;
}
print Local::Test->new(id => 'xyz123')->dump;
print Local::Test->new(id => undef)->dump;
print Local::Test->new->dump;
You could also look at MooseX::UndefTolerant which makes undef values passed to the constructor act as if they were entirely omitted. This won't cover passing undef to accessors though; just constructors.
Here is an alternative, using Moose' BUILD method, which is called after an object is created.
#!/usr/bin/perl
package Test;
use Moose;
has 'id' => (
is => 'rw',
isa => 'Str|Undef',
);
sub BUILD {
my $self = shift;
unless($self->id){
$self->id("id" . (int(rand(1000))+1));
}
}
1;
package Main;
my $test = Test->new(id => undef);
print $test->id; ###Prints random number if id=> undef
More info on BUILD here:
http://metacpan.org/pod/Moose::Manual::Construction#BUILD
#choroba in a comment mentioned about the triggers. Based on this, found a next solution. The trigger is called twice in the case id=>undef, but otherwise it works.
use Modern::Perl;
package My;
use namespace::sweep;
use Moose;
my $_id_default = sub { "id" . int(rand(100_000_000_000)+1) };
my $_check_id = sub { $_[0]->id(&$_id_default) unless $_[1] };
has id => (
is => 'rw',
isa => 'Str|Undef',
default => $_id_default,
trigger => $_check_id,
);
__PACKAGE__->meta->make_immutable;
package main;
say My->new->id;
say My->new(id=>'aaa')->id;
say My->new(id=>undef)->id;
I'm trying to use an alias with MooseX::Aliases and MooseX::Constructor::AllErrors
However, the two don't seem to play nicely together. Consider the following example:
package Alias
{
use Moose;
use MooseX::Aliases;
use MooseX::Constructor::AllErrors;
has foo => (
is => 'rw', isa => 'Str', required => 1, alias => 'bar'
);
}
use strict;
use warnings;
use Alias;
my $obj;
eval {
$obj = Alias->new( bar => 'alias_value' );
};
if ($#)
{
foreach my $error ( $#->errors )
{
print $error ."\n";
print $error->message ."\n";
}
exit 1;
}
print $obj->bar ."\n";
$obj->foo( 'new_alias_value' );
print $obj->foo."\n";
1;
This should allow me to create an Alias object using the 'bar' alias... shouldn't it? Does anyone know if MooseX::Constructor::AllErrors is supposed to support aliased attributes?
It's a bug, in that it violates expectations, but it's not easily resolvable -- the problem is that MooseX::Aliases modifies what arguments are allowed/accepted in the constructor, but MooseX::Constructor::AllErrors is not aware of this, so when it looks at the passed values at construction time, it errors out when there is no 'agency' field.
This gets around the situation by manually moving the aliased field before MooseX::Constructor::AllErrors sees it:
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my %args = #_;
$args{agency} //= delete $args{company};
$self->$orig(%args);
};
The good news is that this has hope of working better in the future, because
there are plans for MooseX::Aliases to be cored, which would force all other
extensions (e.g. MXCAE) to support the alias feature properly.
I of course know that I can rename the init arg for an attribute by setting init_arg (e.g)
package Test {
use Moose;
has attr => (
is => 'ro',
isa => 'Str',
init_arg => 'attribute'
);
}
which would allow me to
Test->new({ attribute => 'foo' });
but not
Test->new({ attr => 'foo' });
at the same time
MooseX::Aliases actually has this behavior, but creating an alias also creates accessors. I'm currently trying to understand the code in that module to see if I can't determine how it does it, so that I can replicate said functionality (in a way I understand). If someone could explain how to do it here with an example that'd be great.
update it appears that MX::Aliases is doing this by way of replacing what's actually passed to the constructor in an around initialize_instance_slot but I'm still not sure how that's actually getting called, because in my test code my around isn't actually getting executed.
update munging in BUILDARGS isn't really an option because what I'm trying to do allow setting of the accessor via the name of the label I'm adding to the attribute via Meta Recipe3. You might say I'm doing
has attr => (
is => 'ro',
isa => 'Str',
alt_init_arg => 'attribute'
);
update
here's what I've managed to work out with what I'm trying to do so far.
use 5.014;
use warnings;
package MooseX::Meta::Attribute::Trait::OtherName {
use Moose::Role;
use Carp;
has other_name => (
isa => 'Str',
predicate => 'has_other_name',
required => 1,
is => 'ro',
);
around initialize_instance_slot => sub {
my $orig = shift;
my $self = shift;
my ( $meta_instance, $instance, $params ) = #_;
confess 'actually calling this code';
return $self->$orig(#_)
unless $self->has_other_name && $self->has_init_arg;
if ( $self->has_other_name ) {
$params->{ $self->init_arg }
= delete $params->{ $self->other_name };
}
};
}
package Moose::Meta::Attribute::Custom::Trait::OtherName {
sub register_implementation { 'MooseX::Meta::Attribute::Trait::OtherName' }
}
package Message {
use Moose;
# use MooseX::StrictConstructor;
has attr => (
traits => [ 'OtherName' ],
is => 'ro',
isa => 'Str',
other_name => 'Attr',
);
__PACKAGE__->meta->make_immutable;
}
package Client {
use Moose;
sub serialize {
my ( $self, $message ) = #_;
confess 'no message' unless defined $message;
my %h;
foreach my $attr ( $message->meta->get_all_attributes ) {
if (
$attr->does('MooseX::Meta::Attribute::Trait::OtherName')
&& $attr->has_other_name
) {
$h{$attr->other_name} = $attr->get_value( $message );
}
}
return \%h;
}
__PACKAGE__->meta->make_immutable;
}
my $message = Message->new( Attr => 'foo' );
my $ua = Client->new;
my %h = %{ $ua->serialize( $message )};
use Data::Dumper::Concise;
say Dumper \%h
problem is that my around block is never being run and I'm not sure why, maybe I'm wrapping it in the wrong place or something.
MooseX::Aliases has several moving parts to make this functionality happen, that's because the behavior needs to be applied to several different places in the MOP. Your code here looks very close to the code in MooseX::Aliases's Trait attribute.
I suspect the reason your code isn't being called is due to something going wrong when you try to register your trait. MooseX::Aliases uses Moose::Util::meta_attribute_alias rather than the old fashioned way you're using here. Try replacing your Moose::Meta::Attribute::Custom::Trait::OtherName section with a call to Moose::Util::meta_attribute_alias 'OtherName'; inside your Role.
Second the code you have here won't work for immutable classes. You'll need to add a second trait to handle those because the immutability code is handled by the class's metaclass and not the attribute's metaclass. You'll need to add some more traits to handle attributes in Roles as well I think. Then you'll need to wire up an Moose::Exporter to make sure that all the traits are applied properly when everything is compiled.
I've gotten a simple version of this working up through immutable. This code is also on github.
First the Attribute trait:
package MooseX::AltInitArg::Meta::Trait::Attribute;
use Moose::Role;
use namespace::autoclean;
Moose::Util::meta_attribute_alias 'AltInitArg';
has alt_init_arg => (
is => 'ro',
isa => 'Str',
predicate => 'has_alt_init_arg',
);
around initialize_instance_slot => sub {
my $orig = shift;
my $self = shift;
my ($meta_instance, $instance, $params) = #_;
return $self->$orig(#_)
# don't run if we haven't set any alt_init_args
# don't run if init_arg is explicitly undef
unless $self->has_alt_init_arg && $self->has_init_arg;
if (my #alternates = grep { exists $params->{$_} } ($self->alt_init_arg)) {
if (exists $params->{ $self->init_arg }) {
push #alternates, $self->init_arg;
}
$self->associated_class->throw_error(
'Conflicting init_args: (' . join(', ', #alternates) . ')'
) if #alternates > 1;
$params->{ $self->init_arg } = delete $params->{ $alternates[0] };
}
$self->$orig(#_);
};
1;
__END__
Next the Class trait.
package MooseX::AltInitArg::Meta::Trait::Class;
use Moose::Role;
use namespace::autoclean;
around _inline_slot_initializer => sub {
my $orig = shift;
my $self = shift;
my ($attr, $index) = #_;
my #orig_source = $self->$orig(#_);
return #orig_source
# only run on aliased attributes
unless $attr->meta->can('does_role')
&& $attr->meta->does_role('MooseX::AltInitArg::Meta::Trait::Attribute');
return #orig_source
# don't run if we haven't set any aliases
# don't run if init_arg is explicitly undef
unless $attr->has_alt_init_arg && $attr->has_init_arg;
my $init_arg = $attr->init_arg;
return (
'if (my #aliases = grep { exists $params->{$_} } (qw('
. $attr->alt_init_arg . '))) {',
'if (exists $params->{' . $init_arg . '}) {',
'push #aliases, \'' . $init_arg . '\';',
'}',
'if (#aliases > 1) {',
$self->_inline_throw_error(
'"Conflicting init_args: (" . join(", ", #aliases) . ")"',
) . ';',
'}',
'$params->{' . $init_arg . '} = delete $params->{$aliases[0]};',
'}',
#orig_source,
);
};
1;
__END__
Finally the Moose::Exporter glue.
package MooseX::AltInitArg;
use Moose();
use Moose::Exporter;
use MooseX::AltInitArg::Meta::Trait::Attribute;
Moose::Exporter->setup_import_methods(
class_metaroles => { class => ['MooseX::AltInitArg::Meta::Trait::Class'] }
);
1;
__END__
An example of how this is used then:
package MyApp;
use 5.10.1;
use Moose;
use MooseX::AltInitArg;
has foo => (
is => 'ro',
traits => ['AltInitArg'],
alt_init_arg => 'bar',
);
my $obj = MyApp->new( bar => 'bar' );
say $obj->foo; # prints bar
Meta-Programming in Moose is incredibly powerful, but because there are a lot of moving parts (many of which have solely to do with maximizing performance) you bite off a lot of work when you dive in.
Good luck.
I could be wrong but I think you might be able to accomplish what I think you are trying to do using the BUILDARGS method. This lets you munge the contructor arguments before they are used to create the object.
#!/usr/bin/env perl
use strict;
use warnings;
{
package MyClass;
use Moose;
has attr => (
is => 'ro',
isa => 'Str',
required => 1,
);
around BUILDARGS => sub {
my $orig = shift;
my $self = shift;
my %args = ref $_[0] ? %{shift()} : #_;
if (exists $args{attribute}) {
$args{attr} = delete $args{attribute};
}
$self->$orig(%args);
};
}
my $one = MyClass->new(attribute => "Hi");
my $two = MyClass->new(attr => "Bye");
print $one->attr, "\n";
print $two->attr, "\n";
So what I'm hearing is that:
At construction time, an attribute should be able to be set by its init_arg and any alternate init_args defined on the attribute.
An attribute should not be able to be manipulated by its alternate init_args except at instance construction; that is, aside from the above, the attribute should behave "normally".
Based on that, this seems like a good match for the MooseX::MultiInitArg attribute trait. Yes? :)
I've received a lot of exceptions from QA due to incomplete data being fed to my Moose constructors. The attribute name is present in the constructor arguments, but the value is undef.
It's a fact of life with many scripting applications that things are just undef. And oftentimes this is perfectly fine. You don't want an annoying warning from the warnings pragma (so you do no warnings 'uninitialized'), and you certainly don't want your code to die because one little value, say the housenumber, is undef.
So without further ado, I want my Moose constructors to behave like straight Perl (i.e. without use warnings 'uninitialized'), which is to convert undef to 0 or the empty string as required. The attempt shown in this sample does not work for the case where the attribute name is present but the value is undef. I could think of using BUILDARGS to achieve what I want. But is there a declarative way in plain Moose without resorting to MooseX::UndefTolerant (which unfortunately I cannot use as it is not installed)?
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has '+hu', default => ''; # don't want to die on undef
has '+ba', default => 0; # idem
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
done_testing;
In Moose::Manual::Types is a way documented to deal with exactly this kind of problem.
Use the Maybe[a] type.
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has 'hu', is => 'rw', isa => 'Maybe[Str]', default => ''; # will not die on undef
has 'ba', is => 'rw', isa => 'Maybe[Int]', default => 0; # idem
sub BUILD {
my $self = shift;
$self->hu('') unless defined $self->hu;
$self->ba(0) unless defined $self->ba;
}
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
my $bbb = BBB->new( hu => undef, ba => undef );
is $bbb->hu, '', "hu is ''";
is $bbb->ba, 0, 'ba is 0';
done_testing;
Your complaint really is that Moose is doing exactly what it is supposed to be doing. If you explicitly pass undef as a value, but that value can only be an Int, then you should get an error.
So you need to make a choice. You can either change the type (via union) to allow undef as a valid value like so:
has 'hu', is => 'ro', isa => 'Str | Undef';
has 'ba', is => 'ro', isa => 'Int | Undef';
Or you can just not send in undefined values:
my %aa_params = ();
$aa_params{hu} = $foo if defined $foo;
$aa = AA->new( %aa_params );
Or finally, for some unknown reason you absolutely cannot resist sending in invalid undefined values for things which should not be explicitly set to undefined, just write a quick filter:
sub filt_undef {
my %hash = #_;
return map { $_ => $hash{$_} } grep { defined $hash{$_} } keys %hash;
}
$aa = AA->new( filt_undef( hu => undef ) );
But this seems rather awkward and awful.
Or use on-the-fly coercion:
package BBB;
use Moose;
use MooseX::AttributeShortcuts;
extends 'AAA';
has '+hu',
traits => [Shortcuts],
coerce => [ Undef => sub { '' } ],
;