I want to add a new feature for Perl language, in order to type less $self->.
For example, Translate:
use Moo;
has a_attr => (is=>'rw');
sub XXX {
print $self->a_attr;
}
To:
use Moo;
use MyFeatureModule;
has a_attr => (is=>'rw');
sub XXX {
print _a_attr;
}
How-to?
This doesn't require any changes to Perl's syntax, only to its semantics. Luckily, that's not too hard.
What you want can be achieved by providing an AUTOLOAD sub for your package, which will kick in automatically whenever you call a sub that hasn't been defined yet (i.e. _a_attr in your example). This AUTOLOAD method can then use Devel::Caller to grab $_[0] (i.e. $self) from its caller, inject it onto #_ and then goto the original method.
use v5.14;
use strictures;
package Foo {
use Moo;
has xyzzy => (is => 'ro', default => 42);
sub sayit {
say _xyzzy();
}
sub AUTOLOAD {
require Devel::Caller;
my ($invocant) = Devel::Caller::caller_args(1);
unshift #_, $invocant;
my ($method) = (our $AUTOLOAD =~ /::_(\w+)\z/)
or die "Method not found!";
my $coderef = $invocant->can($method)
or die "Method not found!";
goto $coderef;
};
}
my $obj = Foo->new;
$obj->sayit;
Is this a good idea? Well, I certainly wouldn't do it. As well as introducing an unnecessary level of slow-down to your code, and breaking inheritance, it is likely to confuse anybody who has to maintain your code after you. (And that might be your future self if you take a break from the project, and come back to it in 6 months.)
Related
I have really no idea, why this is wrong:
#!/usr/bin/perl
use v5.20;
package MyDate;
sub new{ bless {}, shift; }
sub AUTOLOAD{
my $f = our $AUTOLOAD;
my #h{qw[Wday Month Year]} = (localtime)[3,4,5];
}
Err:compilation error near "#h{"
If I delete my (or even if package-scoped with our):
#h{qw[Wday Month Year]} = (localtime)[3,4,5];
It will magically works. Why cannot be hash slices lexically scoped?
Edit: Yes - I have not noticed, that (localtime)[3] = mday not wday. But that is not the point. I am asking about the scope, not localtime func.
Edit2: The hash %h (the point of my question), is intended to be used inside the autoload sub (well, of course when I am trying to use it as hash slice there). Just for clarity.
#h{...} is not a variable, so you can't declare it as such.
#h{...} = ...; sets elements of %h. So it's %h you need to create.
This is done as follows:
my %h;
By the way, I doubt you have a legitimate reason for using AUTOLOAD. Keep in mind that code at the top level (at the file level) of a module will be executed when the module is first loaded in an interpreter.
I hope that you will see your mistakes from following piece of code
use strict;
use warnings;
use diagnostics;
use v5.20;
package MyDate;
sub new{ bless {}, shift; }
sub AUTOLOAD{
my $f = our $AUTOLOAD;
#my %h; # !!! without hash declaration compilation error
# 0 1 2 3 4 5 6 7 8
#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
# localtime(time);
#h{qw[Wday Month Year]} = (localtime)[6,4,5];
}
perl hash_package.pl
Global symbol "%h" requires explicit package name (did you forget to declare "my %h"?) at hash_package.pl line 15.
Execution of hash_package.pl aborted due to compilation errors (#1)
(F) You've said "use strict" or "use strict vars", which indicates
that all variables must either be lexically scoped (using "my" or "state"),
declared beforehand using "our", or explicitly qualified to say
which package the global variable is in (using "::").
Uncaught exception from user code:
Global symbol "%h" requires explicit package name (did you forget to declare "my %h"?) at hash_package.pl line 15.
Execution of hash_package.pl aborted due to compilation errors.
This is just a big WAG at what the OP is trying to do. So it's a pretty crappy SO answer according to site conventions, but I think it might help unmuddy the waters for our suffering OP.
I'm going to start with the code the OP posted, comment a bit on it, and then move to several examples of the "right way to do it".
OP's code:
#!/usr/bin/perl
So we're running a script.
use v5.20;
With version 5.20 or better. So far, so good.
package MyDate;
Now we've selected a new namespace/package called MyDate. While this isn't illegal, it is generally considered desirable to have one package per file.
sub new{ bless {}, shift; }
We have a constructor. So MyDate is going to be a class. Maybe worth looking at Moose or Moo for help with automating some of the boring crap with class construction. But there isn't anything wrong with using good, ole' classical Perl objects.
sub AUTOLOAD{
my $f = our $AUTOLOAD;
my #h{qw[Wday Month Year]} = (localtime)[3,4,5];
}
The syntax error, the source of all pain. AUTOLOAD is called to handle any unknown function calls in the namespace. So, this in-effect, intercepts all undefined method calls. MyDate has an infinite list of methods. It's probably not what is really needed.
Let's rework things a bit:
Here's my guess at the sort of thing the OP may want in their script file:
#!/usr/bin/perl
use v5.20;
use strict; # Make life easier by catching bugs at compile time.
use warnings; # Catch things that probably indicate errors, but aren't technically illegal.
use MyDate; # Load my date class
# Make some dates
my $today = MyDate->new();
my $aprilish = MyDate->new( month => 4 );
# Do stuff with them!
print_date( $today );
print_date( $aprilish );
sub print_date {
my ($date) = #_;
say "Weekday: ", $date->wday();
say "Month: ", $date->month();
say "Year: ", $date->year();
}
Library File: MyDate.pm
package MyDate;
use v5.20; # Set the minimum perl version required. Optional, but useful.
use strict; # Always
use warnings;
sub new {
my ($class, %parts) = #_;
my %defaults; #defaults[wday month year] = localtime(3, 4, 5)
my $self = bless {
%defaults,
}, $class;
for my $part ( qw/ month wday year /) {
next unless exists $parts{$part};
$self->$part( $parts{$part} ); # Call the associated method to initialize an attribute.
delete $parts{$part};
}
die "Unknown attributes: ", join ', ', keys %parts # Fatal error on unknown args
if %parts;
return $self;
}
# The other methods are mostly identical.
sub month {
my ($self, $value) = #_;
if ( #_ == 2 ) { # If two args are passed, we are a setter.
$self->{month} = $value;
}
return $self->{month};
}
That's a classical perl OO version of something like the OP is going for, I think.
It's a lot less hassle to write with Moo.
package MyDate;
use v5.20; # Set the minimum perl version required. Optional, but useful.
use Moo; # Turns on strict and warnings;
use namespace::autoclean; # Removes any utility functions so they don't show up as methods.
has 'month' => (
is => 'ro',
builder => 1,
);
has 'wday' => (
is => 'ro',
builder => 1,
);
has 'year' => (
is => 'ro',
builder => 1,
);
sub _build_month { localtime()[4] }
sub _build_wday { localtime()[3] }
sub _build_year { localtime()[5] }
But probably the best thing to do would be to take an existing date manipulation library like DateTime and use it.
#!/usr/bin/perl
use v5.20;
use strict; # Make life easier by catching bugs at compile time.
use warnings; # Catch things that probably indicate errors, but aren't technically illegal.
use DateTime; # Load my date class
# Make some dates
my $today = DateTime->today();
my $aprilish = DateTime->today()->set_month( 4 );
# Do stuff with them!
print_date( $today );
print_date( $aprilish );
sub print_date {
my ($date) = #_;
say "Weekday: ", $date->day_of_week();
say "Month: ", $date->month();
say "Year: ", $date->year();
}
Anyhow, I hope that all this is useful to the OP, and maybe, just maybe, to someone else.
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 have a class called Question, and a bunch of sub-classes depending on the type of question. I can create objects against the sub-classes, but I shouldn't be able to create an object of class Question itself:
#! /usr/bin/env perl
use strict;
use warnings;
#
# LOAD IN YOUR QUESTIONS HERE
#
my #list_of_questions;
for my $question_type qw(Science Math English Dumb) {
my $class = "Question::$question_type";
my $question = $class->new;
push #list_of_questions, $question;
}
package Question;
use Carp;
sub new {
my $class = shift;
my $self = {};
if ( $class = eq "Question" ) {
carp qq(Need to make object a sub-class of "Question");
return;
}
bless $self, $class;
return $self;
}
yadda, yadda, yadda...
package Question::Math;
use parent qw(Question);
yadda, yadda, yadda...
package Question::Science;
use parent qw(Question);
yadda, yadda, yadda...
package Question::English;
use parent qw(Question);
yadda, yadda, yadda...
Notice these are not modules, but merely classes I've defined to be used in my program. Thus, I can't test module loading at runtime.
When I run the above, I get:
Can't locate object method "new" via package "Question::Dumb" (perhaps you forgot to load "Question::Dumb"?)
Is there any way to catch for this particular error, so I can handle it myself? I know I could create an array of valid types, but I was hoping someway of being able to add new question type without having to remember to update my array.
AFAICT what you want to do is check the symbol table to see if your "class" (aka "package") has been defined or not. Doing it manually is no hardship, but Class::Load provides slightly more readable sugar and applies "heuristics" - whatever that means. If you don't want to use this module then the source code for is_class_loaded will lead you to whatever answer you're actually seeking.
use Class::Load qw(is_class_loaded);
for my $question_type (qw(Math English Science Dumb)) {
my $class = "Question::$question_type";
if(!is_class_loaded($class)) {
# construct your new package at runtime, then
}
new_question($class);
}
Your variable name ("class_type") was weird, so I fixed it. I also don't know whether Module::Load is better, but we use Class::Load for this at work.
Edit: bare qw()s are deprecated in one of the newer Perls (5.14?). It's a stupid deprecation, but it's there, so we all have to learn to wrap our qw() foreachs in parens now.
You can't have an expression like Invalid::Class->new() not throw an exception in the calling code, but you can wrap it in exception handling and wrap that inside a method. The standard pattern is to supply a 'type' argument describing the subclass you which to create to a factory method. A common anti-pattern is to put that factory method on the base class, creating a circular dependency and having to do more work than should be required.
It is usual to have the factory method on the interface class and to have it construct sub-classes of an unrelated, dedicated base class, possibly warning or throwing when it fails. In code, that looks pretty much like so:
package Question;
use Try::Tiny;
use Carp qw/carp/;
sub new {
my ($class, $type, #args) = #_;
# could do some munging on $type to make it a class name here
my $real_class = "Question::$type";
return try {
$real_class->new(#args);
} catch {
# could differentiate exception types here
carp qq(Invalid Question type "$type");
};
}
package Question::Base;
sub new {
my ($class) = #_;
return bless {} => $class;
}
package Question::Math;
use base 'Question::Base'; # `use parent` expects to load a module
package main;
use Test::More tests => 2;
use Test::Warn;
isa_ok(Question->new('Math'), 'Question::Math');
warning_like(
sub { Question->new('Dumb') }, # I hear there's no such thing
qr/^Invalid Question/
);
Here's what I finally did:
package Question;
use Carp;
sub new {
my $class = shift;
my %params = #_;
#
# Standardize the Parameters
# Remove the dash, double-dash in front of the parameter and
# lowercase the name. Thus, -Question, --question, and question
# are all the same parameter.
#
my %option_hash;
my $question_type;
for my $key (keys %params) {
my $value = $params{$key};
$key =~ s/^-*//; #Remove leading dashes
$key = ucfirst ( lc $key ); #Make Key look like Method Name
if ( $key eq "Type" ) {
$question_type = ucfirst (lc $value);
}
else {
$option_hash{$key} = $value;
}
}
if ( not defined $question_type ) {
carp qq(Parameter "type" required for creating a new question.);
return;
}
#
# The real "class" of this question includes the question type
#
my $self = {};
$class .= "::$question_type";
bless $self, $class;
#
# All _real does is return a _true_ value. This method is in this
# class, so all sub-classes automatically inherit it. If the eval
# fails, this isn't a subclass, or someone wrote their own `_real_
# method in their sub-class.
#
eval { $self->_real; };
if ( $# ) {
carp qq(Invalid question type of $question_type);
return;
}
#
# Everything looks good! Let's fill up our question object
#
for my $method ( keys %option_hash ) {
my $method_set;
eval { $method_set = $self->$method( $option_hash{$method} ) };
if ( $# or not $method_set ) {
carp qq(Can't set "$method" for question type "$question_type");
return;
}
}
return $self;
}
Now, I'm setting my question like this:
my $question = Question->new(
--type => Integer,
--question => "Pick a number between 1 and 10.",
--help => "Try using the top row of your keyboard...",
--from => "1",
--to => "10",
);
if ( not defined $question ) {
die qq(The question is invalid!);
}
Darch use of the Try::Tiny is nice. It looks way better than wrapping everything in an eval. Unfortunately, it's not a standard module. This program is going on almost 100 separate systems, and using CPAN modules is too difficult. This is especially true since these systems are behind a firewall and can't access the CPAN website.
I basically use Darch's method except I create a _real method in my super-class that I try after I bless the object. If it executes (that's all I really care), then this is a sub-class of my super-class.
This does what I really want: Hide my sub-classes behind my superclass -- much like File::Spec does. Most of my classes have the same methods, and a few have one or two extra methods. For example, my Regex question type has a Pattern method that allows me to make sure the answer given matches a given pattern.
I'm building a Perl application that relies on Moose. One task the Moose object needs to accomplish is to use File::Find to populate an attribute with a list of files. I'm having some trouble figuring out how to use find's \&wanted code reference in a way that will let me maintain access to a $self version of the Moose object.
So far, I have this:
#!/usr/bin/perl
package MyMoose;
use Modern::Perl;
use Moose;
use File::Find;
use FindBin qw($Bin);
### Attribute to hold the file list
has "file_list" => (
is => 'rw',
isa => 'ArrayRef',
default => sub {[]}
);
### Method to populate the file list
sub update_file_list {
my $self = shift;
find(\&wanted, $Bin);
}
### File::Find wanted sub
sub wanted {
### This won't work, but shows what I'd like to do
# my $self = shift;
# ### Do some filtering
# push #{$self->file_list}, $File::Find::name;
}
1;
######################################################################
### Main package to test the object.
package main;
use Data::Dumper;
run_main() unless caller();
sub run_main {
my $m = MyMoose->new();
$m->update_file_list();
print Dumper $m->file_list;
}
It runs, but obviously doesn't assemble a file list. That's the part I'm trying to figure out.
What's the proper way to use File::Find so that it will let you have access to the Moose object during processing?
The problem is that you don't have access to $self within wanted sub. You can use inline closure and default or builder to build the list.
Edit: updated code per updated question
has "file_list" => (
is => 'rw',
isa => 'ArrayRef',
default => sub {
my $self = shift;
return $self->_get_file_list();
},
);
sub update_file_list {
my $self = shift;
$self->file_list($self->_get_file_list());
}
sub _get_file_list {
my #files;
find(sub { push #files, $File::Find::name }, $Bin);
return \#files;
}
_get_file_list method returns arrayref of files found. It is used both in default and update_file_list method to populate the attribute.
As bvr notes, the subroutine reference passed to find doesn't need to be a named package method — a lexical closure will work just fine. Thus, you can do this:
sub update_file_list {
my $self = shift;
my $wanted = sub {
### Do some filtering
push #{$self->file_list}, $File::Find::name;
};
find($wanted, $Bin);
}
The lexical variable $self declared in the outer function scope will be visible in the inner function.
In particular, every time the update_file_list method is called, a new $self and a new $wanted will be created (and bound together by the inner reference to $self), so that it's perfectly safe to call the method several times on different objects, even recursively if you want.
After some trial an error, I also got the script to work by replacing the original version of 'update_file_list' with this:
sub update_file_list {
my $self = shift;
find( sub { wanted($self); }, $Bin );
}
That seems to work as well.
I have a module that I'm working on. I am setting up a few attributes like this:
$self->{FOO};
$self->{BAR};
$self->{FOOBAR};
And, I want to use AUTOLOAD to help create methods for accessing these attributes. For example, $foo->Bar() returns the value of $self->{BAR}. No problem. Everything is standard.
Now, I want to create alias Methods. For example, if someone says $obj->Fu();, I'll return $self->{FOO}. What I'd like to do is create a $self->{FU} that points to the same memory location as $self->{FOO}. That way, when I set the value of $self->{FOO}, $self-{FU} is also set. This way, I don't have to make all sorts of changes in the way AUTOLOAD works or remember to set $self->{FU} whenever I set $self->{FOO}.
Any easy way of doing this?
Yes, use Moose, rather than attempting to make explicit mapping between hash
keys. Writing your own accessors, or using AUTOLOAD, is not necessary and has
a much higher chance of error:
package MyClass;
use Moose;
use MooseX::Aliases;
has foo => (
is => 'rw', isa => 'Str',
alias => 'fu',
);
has bar => (
is => 'rw', isa => 'Str',
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
package main;
use strict;
use warnings;
use MyClass;
my $obj = MyClass->new;
$obj->foo("value");
$obj->fu("a new value");
# prints "foo has the value 'a new value'"
print "foo has the value '", $obj->foo, "'\n";
I would recommend Moose over what you're doing, but the easiest way to accomplish what you're asking is probably this:
sub Fu { shift->Foo(#_) }
This way, it doesn't matter if Foo is autoloaded or not.
The non-Moose solution is to just create an alias in the symbol table. It's not a common thing to do, and I suspect that whatever you are trying to do has a better way, Moose or otherwise. Don't use any of this if you can avoid it with a better design or interface, which are often the superior solutions to things like this.
In this AUTOLOAD routine, I look at a %Aliases hash to figure out other methods else I have to define. When I have aliases, I make proper aliases in the symbol table. It's a bit ugly, but it avoids adding another actual method in the call stack:
#!perl
use 5.010;
{
package SomeClass;
use Carp;
use vars qw($AUTOLOAD);
sub new {
return bless {
map { $_, undef } qw(FOO BAR FOOBAR)
}, $_[0];
};
my %Aliases = (
FOO => [ qw(fu) ],
);
sub AUTOLOAD {
our $method = $AUTOLOAD;
$method =~ s/.*:://;
carp "Autoloading $method";
{
no strict 'refs';
*{"$method"} = sub {
#_ > 1
?
$_[0]->{"\U$method"} = $_[1]
:
$_[0]->{"\U$method"}
};
foreach my $alias ( #{ $Aliases{"\U$method"} } ) {
*{"$alias"} = *{"$method"};
}
goto &{"$method"};
}
}
sub DESTROY { 1 }
}
my $object = SomeClass->new;
$object->foo(5);
say "Foo is now ", $object->foo;
say "Foo is now ", $object->foo(9);
say "Fu is now ", $object->fu;
say "Fu is set to ", $object->fu(17);
say "Foo is now ", $object->foo;
Now foo and fu access the same thing:
Foo is now 5
Foo is now 9
Fu is now 9
Fu is set to 17
Foo is now 17