If I have a Perl class eg
package Foo;
sub new {
my ($class,$hashref) = #_;
my $self = bless $hashref, $class;
}
and initialised with
my $foo = Foo->new( { bar => 2, othervar => 8 } );
I can do
print $foo->{ bar };
which feels clunky, and
print $foo->bar
feels more preferable. However, if there are a lot of keys, I'd prefer not to have to write an accessor for every key (or is that best practice) ?
So, I can include
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
my $called = $AUTOLOAD =~ s/.*:://r;
die "No such attribute: $called"
unless exists $self->{$called};
return $self->{$called};
}
sub DESTROY { } # see below
In perldoc perlobj it says
# XXX - this is a terrible way to implement accessors
Are there any good ways to implement accessors like this, without using other packages, eg Moose, Class::Accessor ? I'm just after something light as its just one class that has a lot of keys.
Are there any good ways to implement accessors like this, without using other packages ...
If you insist, then write those subs directly to the package symbol table
package AutoAccessors;
use warnings;
use strict;
use feature 'say';
my #attr_names;
BEGIN {
#attr_names = qw(name mode etc);
no strict 'refs';
foreach my $accessor (#attr_names) {
*{$accessor} = sub { do {
if (#_ == 1) { $_[0]->{$accessor} }
elsif (#_ == 2) { $_[0]->{$accessor} = $_[1] }
#elsif ...
} };
}
};
sub new {
my ($class, $args) = #_;
my $self;
foreach my $attribute (#attr_names) {
# Check, initialize, set from $args, etc
$self->{$attribute} = $args->{$attribute} if $args->{$attribute};
}
return bless $self, $class;
}
1;
Then
use warnings;
use strict;
use feature 'say';
use AutoAccessors;
my $obj = AutoAccessors->new({ mode => '007' });
$obj->name('Bond');
say "name's ", $obj->name;
say "mode: ", $obj->mode;
This is done in a number of CPAN packages (and it's usually more elaborate).
Having said that, I see no good reason to avoid good libraries, far more carefully written and tested and complete. For instance, Moo as a full system comes in at around 5 kloc (if I recall correctly) and has barely a handful of dependencies, while Class::Accessor is just over 200 loc with one dependency that I can see.
Related
I'd like to be able to "inject" methods in a class on the fly, similarly to what happens with Mojolicious helpers. Something like this:
my $s = SomeThing->new;
$s->helper(do_this => sub {
my $self = shift;
$foo = shift;
});
$s->do_this('bar');
I've made it some distance, but I would like the subs that get injected to be operating in the namespace of the class they get injected into, not in the main one. In other words this currently works as follows:
$s->do_this('bar');
print 'in main: ', $foo;
this prints "bar" - and I'd like it not to, while I'd like this
print 'in SomeThing: ', $SomeThing::foo;
to print "bar" instead
while this works but seems clunky to me
$s->helper(do_this => sub {
my $self = shift;
${(ref $self) . '::foo'} = shift;
});
$s->do_this('foo');
print 'in SomeThing: ', $SomeThing::foo; # now this prints "foo"
The package where all this happens looks like this:
package SomeThing {
use Mojo::Base -base;
use Carp;
sub helper {
my $self = shift;
my $name = shift || croak "The helper name is required";
my $sub = shift || sub {};
my $namespace = __PACKAGE__;
no strict 'refs';
{
*{"$namespace\::$name"} = $sub
}
}
};
Is there a way to do this? I suspect I'd be messing up strictness real bad - but I kind of don't want to give up just yet (and it'd be a nice trick to learn).
You are asking to change the package associated with an already-compiled anon sub for the purpose of variable lookups. I don't know if that's possible.
Even if it was possible, it's not something you want to do because your code still wouldn't work. You'd have to add use vars qw( foo ); to the file in which the sub { } literal is found. And that's in addition to using our $foo; or use vars qw( $foo ); in Something.pm if you accessed it there.
That's pretty magical and messy. And it's easily avoided by using accessors. Simple replace
$s->helper(
do_this => sub {
my $self = shift;
$foo = shift;
},
);
with
$s->helper(
do_this => sub {
my $self = shift;
$self->foo(shift);
},
);
If you also need to add the accessor, you can use the following:
$s->helper(
foo => sub {
shift;
state $foo;
$foo = shift if #_;
$foo
},
do_this => sub {
my $self = shift;
$self->foo(shift);
},
);
As an aside, monkey_patch from Mojo::Util can be used as a replacement for helper. (Credit to #brian d foy for bringing it up.) It does the same thing, but it has the two added benefits:
You don't need to support it.
It sets the name of the anon sub so that stack traces use a meaningful name instead of __ANON__.
Switching to monkey_patch doesn't address your problem, but I do recommend using it (or similar) in addition to the change of approach I mentioned above.
use Mojo::Util qw( );
sub helper { shift; Mojo::Util::monkey_patch(__PACKAGE__, #_); }
Consider roles.
# role module
package SomeThing::Role::Foo;
use Role::Tiny;
sub foo { 42 }
1;
# user
use strict;
use warnings;
use SomeThing;
use With::Roles;
my $something_with_foo = SomeThing->with::roles('+Foo');
# new subclass of SomeThing, doesn't affect other usage of SomeThing
my $obj = $something_with_foo->new;
# can also dynamically apply to an existing object
my $obj = SomeThing->new->with::roles('+Foo');
print $obj->foo;
How can I catch access to member variables?
$Class1->{Class2}
If the Class2 field doesn't exist, is is possible to catch this from an internal function?
You can, but you probably shouldn't. The problem here is - if you access a variable within a class directly... then you just can. You can prevent this with a couple of workarounds - and this is where things like Moose come in.
And there's a couple of slightly hacky tricks like inside-out objects (which I think aren't common practice any more - Perl Best Practice advocated them some years back) or using anonymous hashes to hold state.
But failing that - why not use an accessor, and auto-generate one using 'AUTOLOAD'.
#!/usr/bin/env perl
package MyClass;
use strict;
use warnings;
use vars '$AUTOLOAD';
sub AUTOLOAD {
my ( $self ) = #_;
my $subname = $AUTOLOAD =~ s/.*:://r;
if ( $self -> {$subname} ) {
return $self -> {$subname};
}
warn "Sub called $subname was called\n";
return "$subname";
}
sub new {
my ( $class ) = #_;
my $self = {};
bless $self, $class;
}
package main;
use strict;
use warnings;
my $object = MyClass -> new;
$object -> {var} = "fleeg";
print "Undef fiddle was: ", $object -> fiddle,"\n";
print "But 'var' was: ", $object -> var,"\n";
This has the same problem, in that changing method names might cause things to break. However it has the advantage that you can handle 'invalid' method calls however you like.
But really - explicit 'get' and 'set' methods are better choices for most use-cases.
You do this by providing proper getter/setter methods that wrap around your class/instance variables. The internals should never be accessed directly, particularly from outside of the class itself (it's wise to not do so within the class either, except for the actual method that maintains that specific attribute. Here's a very basic example:
use warnings;
use strict;
package A;
sub new {
my ($class, %args) = #_;
my $self = bless {}, $class;
$self->x($args{x});
$self->y($args{y});
return $self;
}
sub x {
my ($self, $x) = #_;
$self->{x} = $x if defined $x;
return $self->{x} // 1;
}
sub y {
my ($self, $y) = #_;
$self->{y} = $y if defined $y;
return $self->{y} // 2;
}
package main;
my $obj = A->new(x => 5, y => 3);
print $obj->x ."\n";
print $obj->y ."\n";
Now, you could just as easily do print $obj->{x}, but that's where your problem is. What happens when the code is much more complicated than this, and for some reason you want to change the x attribute name to foo, but retain the x() method? $obj->{x} will now be undef as its never set.
Always use the provided methods for accessing attributes of a class/object. Encapsulation such as this is a staple of OO programming.
I want to create a hash reference with code references mapped to scalars (strings) as its members.
So far I have a map reference that looks something like this:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$object->{code1}->($object->{code2}->());
}
};
$object->{code3}->();
I would like to be able to "bless" the 'code3' reference in $object with $object, so I can do something like:
my $object;
$object = {
'code1' => sub {
print $_[0];
},
'code2' => sub {
return 'Hello, World!';
},
'code3' => sub {
$self = shift;
$self->{code1}->($self->{code2}->());
}
};
$object->{code3}->();
However, bless only works with packages, rather than hash tables.
Is there a way to do this in Perl 5 version 22?
Note: now that I think of it, it's better to pass $object to the method explicitly, as it solves JavaScript's "this" problem. I am just too used to Java's "this" which makes sense in Java where everything is a class and therefore all methods have a "this", but in scripting, it really helps to know if the "this" is actually passed, or is it just called as a function(and you end up accidentally polluting global scope or triggering strict warning) passing $self explicitly makes it clear that you are not calling it as a function, but as a method.
You are doing sub calls (not method calls), so you simply forgot to pass $self as a parameter.
my $object = {
code1 => sub {
print $_[0];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->{code1}->( $self, $self->{code2}->($self) );
}
};
$object->{code3}->($object);
But I think you're trying to create JavaScript-like objects. You can start with the following:
package PrototypeObject;
sub new {
my $class = shift;
my $self = bless({}, $class);
%$self = #_;
return $self;
}
sub AUTOLOAD {
my $self = shift;
( my $method = our $AUTOLOAD ) =~ s/^.*:://s;
return $self->{$method}->($self, #_);
}
1;
use PrototypeObject qw( );
my $object = PrototypeObject->new(
code1 => sub {
print $_[1];
},
code2 => sub {
return 'Hello, World!';
},
code3 => sub {
my $self = shift;
$self->code1( $self->code2() );
}
);
$object->code3();
Note that this will slow down your method calls as it must call AUTOLOAD before calling your method. This could be addressed by overloading the method call operator.
Check on CPAN. Someone might already have a more complete implementation.
This is not the exact syntax you want, but Perl 5 supports many ways of making method calls, including method calls via strings. So you could say:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
my $o = Foo->new;
print "normal call\n";
$o->code3;
print "via string\n";
my $method = "code3";
$o->$method;
Also, remember that a package's symbol table is a hash: %Foo::, so you can always go spelunking in there yourself:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
sub code1 { my $self = shift; print "$_[0]\n" };
sub code2 { "Hello, World!" }
sub code3 {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
}
}
use strict;
use warnings;
print $Foo::{code2}->(), "\n";
However, I would suggest having a really code reason for these techniques as it can make maintenance a nightmare (eg imaging trying to find all of the code calling Foo::approved, you can't just grep for "->approved" because the actual call is ->$state()).
I just read the comments and noticed you said
my concern with packages is that I can't seem to create packages at runtime, but I can create hash tables at runtime
Perl 5 does allow you to create packages at runtime. In fact, depending on how you define runtime, you can do anything at runtime with string eval as it reenters compile time when it is called. But there is also a pure-runtime method of manipulating the symbol tables with typeglobs:
#!/usr/bin/perl
{ package Foo;
use strict;
use warnings;
sub new { bless {}, shift }
}
use strict;
use warnings;
my $o = Foo->new;
# here we add functions at runtime to the package Foo
{
no warnings "once";
*Foo::code1 = sub { my $self = shift; print "$_[0]\n" };
*Foo::code2 = sub { "Hello, World!" };
*Foo::code3 = sub {
my $self = shift;
my $method1 = "code1";
my $method2 = "code2";
$self->$method1($self->$method2);
};
}
$o->code3;
Because Perl 5 is object oriented (and not object based like JavaScript) these methods are attached to all Foo objects. If you want individual objects have their own symbol tables, then I am there are certainly ways to do that. Off the top of my head, AUTOLOAD comes to mind:
#!/usr/bin/perl
{ package Foo;
use strict;
use Carp;
use warnings;
sub new {
bless {
symtab => {}
}, shift
}
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
my $method = $AUTOLOAD =~ s/.*:://r;
my (undef, $file, $line) = caller();
die "$method does not exist at $file line $line"
unless exists $self->{symtab}{$method};
$self->{symtab}{$method}->($self, #_);
}
sub DESTROY {} # prevent DESTROY method from being hijacked by AUTOLOAD
}
use v5.22;
use warnings;
my $o1 = Foo->new;
my $o2 = Foo->new;
$o1->{symtab}{inc} = sub { my $self = shift; $self->{i}++; };
$o1->inc;
$o1->inc;
$o1->inc;
say "inc called on o1 $o1->{i} times";
$o2->inc; #dies because we haven't defined inc for $o2 yet
Perl 5 is very flexible and will let you do just about anything you want (after all the motto is TIMTOWTDI), but you should always keep in mind the future programmer tasked with maintaining your code who may want to hunt you down and wear your skin for doing some of these tricks.
This question has a definite XY problem feel. It seems like you are trying to solve a problem in Perl 5 the same way you would have solved it in JavaScript. While Perl 5 will let you do that (as I have demonstrated), there may be a more idiomatic way of achieving the same effect. Can you describe what you are trying to do (not how you want to do it) in a different question and we can suggest the ways in which we would solve your problem.
I'm just trying to do this: http://modernperlbooks.com/mt/2011/08/youre-already-using-dependency-injection.html. Really not deviating too much at all from that example code.
Here's what I've got:
package M;
use Moose;
use Exporter;
use Data::Dumper;
sub new {
print "M::new!\n";
my $class = shift;
return bless {}, $class;
}
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
#################################
package Foo;
use Moose;
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = ();
has 'mS', is => 'ro', default => sub { M->new };
sub new {
my $class = shift;
return bless {}, $class;
}
sub bar {
my ($self, $data) = #_;
# do stuff here...
# ...
my $foo = $self->mS;
# this...
$foo->x($data);
# ...causes "Can't call method "x" on an undefined value at Foo.pm line 45."
}
1;
It's worth noting that the M::new! message never appears, so I'm guessing that it's never reached. What's going on?
With Moose, you shouldn't write sub new. Moose provides the constructor for you.
Also, using Exporter makes no sense with object-oriented modules. The following program works for me:
#!/usr/bin/perl
{ package M;
use Moose;
use Data::Dumper;
sub x {
my ($self, $stuff) = #_;
print Dumper($stuff);
}
}
{ package Foo;
use Moose;
has mS => ( is => 'ro', default => sub { 'M'->new } );
sub bar {
my ($self, $data) = #_;
my $foo = $self->mS;
$foo->x($data);
}
}
my $foo = 'Foo'->new;
$foo->bar('test');
You have a solution - don't write your own new() method when you're using Moose. But there's one other little point that might be worth making.
The constructor that Moose will give you for your Foo class will work pretty well as a drop-in replacement for your new() method. But the one that Moose gives you for your M class will be missing a feature - it won't print your "M::new!\n" message. How do we get round that?
In Moose, you can define a BUILD() method which will be called immediately after new() has returned a new object. That's a good place to put any extra initialisation that your new object needs. It would also be be a good place for your print() call (although it happens after object construction, not before - so it's not an exact replacement).
So I am toying with some black magic in Perl (eventually we all do :-) and I am a little confused as to exactly how I am supposed to be doing all of this. Here is what I'm starting with:
use strict;
use warnings;
use feature ':5.10';
my $classname = 'Frew';
my $foo = bless({ foo => 'bar' }, $classname);
no strict;
*{"$classname\::INC"} = sub {
use strict;
my $data = qq[
package $classname
warn 'test';
sub foo {
print "test?";
}
];
open my $fh, '<', \$data;
return $fh;
};
use strict;
unshift #INC, $foo;
require $foo;
use Data::Dumper;
warn Dumper(\#INC);
$classname->foo;
I get the following errors (depending on whether my require line is commented out):
With require:
Recursive call to Perl_load_module in PerlIO_find_layer at crazy.pl line 16.
BEGIN failed--compilation aborted.
without:
$VAR1 = [
bless( {
'foo' => 'bar'
}, 'Frew' ),
'C:/usr/site/lib',
'C:/usr/lib',
'.'
];
Can't locate object method "foo" via package "Frew" at crazy.pl line 24.
Any wizards who know some of this black magic already: please answer! I'd love to learn more of this arcana :-)
Also note: I know that I can do this kind of stuff with Moose and other lighter helper modules, I am mostly trying to learn, so recommendations to use such-and-such a module will not get my votes :-)
Update: Ok, I guess I wasn't quite clear originally with my question. I basically want to generate a Perl class with a string (that I will manipulate and do interpolation into) based on an external data structure. I imagine that going from what I have here (once it works) to that shouldn't be too hard.
Here is a version which works:
#!/usr/bin/perl
use strict;
use warnings;
my $class = 'Frew';
{
no strict 'refs';
*{ "${class}::INC" } = sub {
my ($self, $req) = #_;
return unless $req eq $class;
my $data = qq{
package $class;
sub foo { print "test!\n" };
1;
};
open my $fh, '<', \$data;
return $fh;
};
}
my $foo = bless { }, $class;
unshift #INC, $foo;
require $class;
$class->foo;
The #INC hook gets the name of the file (or string passed to require) as the second argument, and it gets called every time there is a require or use. So you have to check to make sure we're trying to load $classname and ignore all other cases, in which case perl continues down along #INC. Alternatively, you can put the hook at the end of #INC. This was the cause of your recursion errors.
ETA: IMHO, a much better way to achieve this would be to simply build the symbol table dynamically, rather than generating code as a string. For example:
no strict 'refs';
*{ "${class}::foo" } = sub { print "test!\n" };
*{ "${class}::new" } = sub { return bless { }, $class };
my $foo = $class->new;
$foo->foo;
No use or require is necessary, nor messing with evil #INC hooks.
I do this:
use MooseX::Declare;
my $class = class {
has 'foo' => (is => 'ro', isa => 'Str', required => 1);
method bar() {
say "Hello, world; foo is ", $self->foo;
}
};
Then you can use $class like any other metaclass:
my $instance = $class->name->new( foo => 'foo bar' );
$instance->foo; # foo-bar
$instance->bar; # Hello, world; foo is foo-bar
etc.
If you want to dynamically generate classes at runtime, you need to create the proper metaclass, instantiate it, and then use the metaclass instance to generate instances. Basic OO. Class::MOP handles all the details for you:
my $class = Class::MOP::Class->create_anon_class;
$class->add_method( foo => sub { say "Hello from foo" } );
my $instance = $class->new_object;
...
If you want to do it yourself so that you can waste your time debugging something, perhaps try:
sub generate_class_name {
state $i = 0;
return '__ANON__::'. $i++;
}
my $classname = generate_class_name();
eval qq{
package $classname;
sub new { my \$class = shift; bless {} => \$class }
...
};
my $instance = $classname->new;
For a simple example of how to do this, read the source of Class::Struct.
However, if I needed the ability to dynamically build classes for some production code, I'd look at MooseX::Declare, as suggested by jrockway.
A Perl class is little more than a data structure (usually a hashref)
that has been blessed into a package in which one or more class
methods are defined.
It is certainly possible to define multiple package namespaces in one
file; I don't see why this wouldn't be possible in an eval construct
that is compiled at run-time (see perlfunc for the two different
eval forms).
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use Data::Dumper;
eval q[
package Foo;
sub new {
my ( $class, %args ) = #_;
my $self = bless { %args }, $class;
return $self;
}
1;
];
die $# if $#;
my $foo = Foo->new(bar => 1, baz => 2) or die;
say Dumper $foo;