Perl Class::Accessor failure, trivial example - why? - perl

Can someone tell me why the main does not find the methods generated by Class::Accessor in this very small and trivial example ?
These few lines of code fail with
perl codesnippets/accessor.pl
Can't locate object method "color" via package "Critter" at
codesnippets/accessor.pl line 6.
see the code:
#!/opt/local/bin/perl
# The whole Class::Accessor thing does not work !!
my $a = Critter->new;
$a->color("blue");
$a->display;
exit 0;
package Critter;
use base qw(Class::Accessor );
Critter->mk_accessors ("color" );
sub display {
my $self = shift;
print "i am a $self->color " . ref($self) . ", whatever this word means\n";
}

Your code is out of order. If you want the color accessor to be available, you need to invoke mk_accessors before you create your object and start doing stuff with it. For example:
package Critter;
use base qw(Class::Accessor);
Critter->mk_accessors("color");
sub display {
my $self = shift;
print $self->color, ' ', ref($self), "\n";
}
package main;
my $c = Critter->new;
$c->color("blue");
$c->display;
More commonly, the Critter code would be in its own module (Critter.pm), and all of the mk_accessor magic would happen when your main script runs use Critter -- well before your script starts working with Critter and Varmint objects.

FM is giving you good advice. mk_accessors needs to run before the other code. Also, normally you'd put Critter in a separate file and use Critter to load the module.
This works because use has compile time effects. Doing use Critter; is the same as doing BEGIN { require Critter; Critter->import; } This guarantees that your module's initialization code will run before the rest of the code even compiles.
It is acceptable to put multiple packages in one file. Often, I will prototype related objects in one file, since it keeps everything handy while I am prototyping. It's also pretty easy to split the file up into separate bits when the time comes.
Because of this, I find that the best way to keep multiple packages in one file, and work with them as if I were using them, is to put the package definitions in BEGIN blocks that end in a true value. Using my approach, your example would be written:
#!/opt/local/bin/perl
my $a = Critter->new;
$a->color("blue");
$a->display;
BEGIN {
package Critter;
use base qw(Class::Accessor );
use strict;
use warnings;
Critter->mk_accessors ("color" );
sub display {
my $self = shift;
# Your print was incorrect - one way:
printf "i am a %s %s whatever this word means\n", $self->color, ref $self;
# another:
print "i am a ", $self->color, ref $self, "whatever this word means\n";
}
1;
}

I just wanted to provide you with a better solution -- feel free to downvote this to oblivion if the solution isn't welcome, but C::A is really a bad idea this day and age, use Moose:
package Critter;
use Moose;
has 'color' => ( isa => 'Str', is => 'rw' ); # Notice, this is typed
sub display {
my $self = shift;
printf (
"i am a %s %s whatever this word means\n"
, $self->color
, $self->meta->name
);
}
package main;
use strict;
use warnings;
my $c = Critter->new; # or my $c = Critter->new({ color => blue });
$c->color("blue");
$c->display;

Related

Perl Import Package in different Namespace

is it possible to import (use) a perl module within a different namespace?
Let's say I have a Module A (XS Module with no methods Exported #EXPORT is empty) and I have no way of changing the module.
This Module has a Method A::open
currently I can use that Module in my main program (package main) by calling A::open I would like to have that module inside my package main so that I can directly call open
I tried to manually push every key of %A:: into %main:: however that did not work as expected.
The only way that I know to achieve what I want is by using package A; inside my main program, effectively changing the package of my program from main to A.
Im not satisfied with this. I would really like to keep my program inside package main.
Is there any way to achieve this and still keep my program in package main?
Offtopic: Yes I know usually you would not want to import everything into your namespace but this module is used by us extensively and we don't want to type A:: (well the actual module name is way longer which isn't making the situation better)in front of hundreds or thousands of calls
This is one of those "impossible" situations, where the clear solution -- to rework that module -- is off limits.
But, you can alias that package's subs names, from its symbol table, to the same names in main. Worse than being rude, this comes with a glitch: it catches all names that that package itself imported in any way. However, since this package is a fixed quantity it stands to reason that you can establish that list (and even hard-code it). It is just this one time, right?
main
use warnings;
use strict;
use feature 'say';
use OffLimits;
GET_SUBS: {
# The list of names to be excluded
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
my #subs = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#subs) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
my $name = name('name() called from ' . __PACKAGE__);
my $id = id('id() called from ' . __PACKAGE__);
say "name() returned: $name";
say "id() returned: $id";
with OffLimits.pm
package OffLimits;
use warnings;
use strict;
sub name { return "In " . __PACKAGE__ . ": #_" }
sub id { return "In " . __PACKAGE__ . ": #_" }
1;
It prints
name() returned: In OffLimits: name() called from main
id() returned: In OffLimits: id() called from main
You may need that code in a BEGIN block, depending on other details.
Another option is of course to hard-code the subs to be "exported" (in #subs). Given that the module seems to be immutable in practice this option is reasonable and more reliable.
This can also be wrapped in a module, so that you have the normal, selective, importing.
WrapOffLimits.pm
package WrapOffLimits;
use warnings;
use strict;
use OffLimits;
use Exporter qw(import);
our #sub_names;
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
BEGIN {
# Or supply a hard-coded list of all module's subs in #sub_names
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
#sub_names = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
1;
and now in the caller you can import either only some subs
use WrapOffLimits qw(name);
or all
use WrapOffLimits qw(:all);
with otherwise the same main as above for a test.
The module name is hard-coded, which should be OK as this is meant only for that module.
The following is added mostly for completeness.
One can pass the module name to the wrapper by writing one's own import sub, which is what gets used then. The import list can be passed as well, at the expense of an awkward interface of the use statement.
It goes along the lines of
package WrapModule;
use warnings;
use strict;
use OffLimits;
use Exporter qw(); # will need our own import
our ($mod_name, #sub_names);
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
sub import {
my $mod_name = splice #_, 1, 1; # remove mod name from #_ for goto
my $re_exclude = qr/^(?:BEGIN|import)$/; # etc
no strict 'refs';
#sub_names = grep { !/$re_exclude/ } sort keys %{ $mod_name . '::'};
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ $mod_name . '::' . $sub_name };
}
push #EXPORT_OK, #sub_names;
goto &Exporter::import;
}
1;
what can be used as
use WrapModule qw(OffLimits name id); # or (OffLimits :all)
or, with the list broken-up so to remind the user of the unusual interface
use WrapModule 'OffLimits', qw(name id);
When used with the main above this prints the same output.
The use statement ends up using the import sub defined in the module, which exports symbols by writing to the caller's symbol table. (If no import sub is written then the Exporter's import method is nicely used, which is how this is normally done.)
This way we are able to unpack the arguments and have the module name supplied at use invocation. With the import list supplied as well now we have to push manually to #EXPORT_OK since this can't be in the BEGIN phase. In the end the sub is replaced by Exporter::import via the (good form of) goto, to complete the job.
You can forcibly "import" a function into main using glob assignment to alias the subroutine (and you want to do it in BEGIN so it happens at compile time, before calls to that subroutine are parsed later in the file):
use strict;
use warnings;
use Other::Module;
BEGIN { *open = \&Other::Module::open }
However, another problem you might have here is that open is a builtin function, which may cause some problems. You can add use subs 'open'; to indicate that you want to override the built-in function in this case, since you aren't using an actual import function to do so.
Here is what I now came up with. Yes this is hacky and yes I also feel like I opened pandoras box with this. However at least a small dummy program ran perfectly fine.
I renamed the module in my code again. In my original post I used the example A::open actually this module does not contain any method/variable reserved by the perl core. This is why I blindly import everything here.
BEGIN {
# using the caller to determine the parent. Usually this is main but maybe we want it somewhere else in some cases
my ($parent_package) = caller;
package A;
foreach (keys(%A::)) {
if (defined $$_) {
eval '*'.$parent_package.'::'.$_.' = \$A::'.$_;
}
elsif (%$_) {
eval '*'.$parent_package.'::'.$_.' = \%A::'.$_;
}
elsif (#$_) {
eval '*'.$parent_package.'::'.$_.' = \#A::'.$_;
}
else {
eval '*'.$parent_package.'::'.$_.' = \&A::'.$_;
}
}
}

why can't I run this perl code?

While following this tutorial
https://www.codeproject.com/Articles/3152/Perl-Object-Oriented-Programming
I am failing to see where module Address.pm is.. did I miss something or article has an error or do I have a misunderstanding when one of the module says ' use Address ';
mac1:moduleTEST1 user1$ ./Employee.pl
Can't locate object method "new" via package "Address" (perhaps you forgot to load "Address"?) at ./Employee.pl line 16.
mac1:moduleTEST1 user1$
The tutorial is outdated and rather useless. Specifically, it is much worse than the documentation which comes with Perl. Use perldoc perltoc to get a table of contents, and read everything at least once.
See perldoc perlootut and perldoc perlobj.
package Address;
use strict;
use warnings;
sub new {
my $class = shift;
my $args = shift;
my %self = map +($_ => $args->{$_}), qw( street city state zip );
bless \%self => $class;
}
sub street {
my $self = shift;
if ( #_ ) {
$self->{street} = $_[0];
return;
}
return $self->{street};
}
# ditto for the rest of the accessors # there are
# ways to cut down the boilerplate once you learn
# the basics
#
# ...
__PACKAGE__
__END__
You use this module like this:
my $address = Address->new({
street => '123 E. Any St',
city => 'Any Town',
state => 'AY',
zip => '98765',
});
Of course, there a lot of things missing from this little demo. For example, the accessor, as written, allows you to change the state of the object. Immutable objects are easier to reason about, so you might want to disallow that by changing it to:
sub street { $_[0]->{street} }
It also allows you to assign any value you want to fields like state and zip. So, you may want to validate those values in the constructor, ensure that only values for the fields of the class are passed, all the values passed are defined etc.
At the end of that process, you may decide it doesn't make sense to keep writing boilerplate and use Moo or Moose to avail yourself to a richer set of features.
Even then, it helps to know what's happening under the hood.

Argument to Perl module use

Having a C background, I may be trying to write something the wrong way so excuse the beginner question. Here is what I'm looking for :
I'm willing to have a perl module Verbose (not a class) that define a subroutine called verbose_print(). This subroutine will print its argument (a string) only if module's variable $verbose is true. Of course, what I'm willing to do is to get the -V option from the command line (using Getopt::Long) and then, is the -V switch is on, call the Verbose module with 'true' being the value for $Verbose::verbose.
One workaround is to have a verbose_init function that set the $Verbose::verbose variable to true inside the Verbose module.
Another one was to declare $verbose in my module using our and then $Verbose::verbose = $command_line_verbose_switch in the main script.
I was wondering if there is another way to do this in perl?
Don't be so afraid of classes in Perl, they're just packages and modules treated a wee bit differently. They don't bite. However, you said no classes, so no classes.
I prefer not to touch package variables directly. Instead, I'll use a subroutine to set them.
Here's my Local::Verbose (stored under Local/Verbose.pm)
package Local::Verbose;
use strict;
use warnings;
use Exporter 'import';
# Could have used just '#EXPORT', but that's bad manners
our #EXPORT_OK = qw(verbose verbose_switch);
# Use "our", so $verbose_value is a package variable.
# This makes it survive between calls to this package
our $verbose_value;
# prints out message, but only if $verbose_value is set to non-blank/zero value
sub verbose {
my $message = shift;
if ( $verbose_value ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
sub verbose_switch {
my $switch_value = shift;
$verbose_value = $switch_value;
return $switch_value;
}
1;
Notice the our. That makes $verbose_value a package variable which means it lives on outside of the package between calls.
Notice how I use Exporter and the #EXPORT_OK array. You can use #EXPORT which will export all of the named subroutines automatically, but it's now considered bad manners since you could end up covering over someone's local subroutine with the same name. Better make it explicit. If there's a problem, they can use the Local::Verbose::verbose name of the verbose subroutine.
And how it's used
use strict;
use warnings;
use Local::Verbose qw(verbose verbose_switch);
verbose ("This is a test");
verbose_switch(1);
verbose ("This is a second test");
By the way, imagine calling the verbose subroutine like this:
verbose($message, $my_verbose_level);
Now, your verbose subroutine could look like this:
sub verbose {
my $message = shift;
my $verbose_level = shift;
if (not defined $verbose) {
$verbose_level = 1;
}
if ( $verbose_value =< $verbose_level ) {
print "VERBOSE: $message\n";
return $message;
}
else {
return;
}
}
Now, you can set your verbose level to various values, and have your verbose statements give you different levels of verbosity. (I do the same thing, but call it debug).
One of 'another ways' is create an import function:
package Verbose;
my $verbose_on;
sub import {
$verbose_on = shift;
}
#... Your code.
Now you can set your verbose like this:
if( ... ) { #check getopt
use Verbose (1); #This will require package Verbose and call "import"
}
But, i think more simple and obivious to further use is make a function-setter.

Can I define a subroutine that can be called like a built-in, everywhere?

Currently, during debugging, I tend to insert
carp Dumper \#foo, \%bar;
statements into my code, and regularly run into the problem that Carp and Data::Dumper are not imported in the current package. To avoid this problem, I defined the following sub in a central file that's always included:
sub main::bla {
use Carp; use Data::Dumper;
carp Dumper #_;
}
So now I can do
main::bla \#foo, \%bar;
everywhere, but the main:: annoys me. Is there something like a global package that's always imported, in any package, automatically (just like built-ins practically are imported everywhere)?
You could just call it
::bla( \#foo, \%bar );
In earlier days, I used to put util functions in a Ut package. And that was fine, but I noticed that my code wasn't really as modular as I thought of it. Each module that depended on Ut functions being there could only succeed if somebody took the trouble to build that namespace.
In the end, I considered use and require statements as simply documenting dependencies. There are more flexible ways to change what code is called by library modules, rather than changing their implementation in main.
For example, you could do this in a single use statement.
use Ut blah => sub {
use Carp;
use Data::Dumper;
carp Dumper #_;
};
And define the import:
sub import {
shift; # It's just me
my ( $name, $impl ) = #_;
if ( $name eq 'blah' && ref( $impl ) eq 'CODE' ) {
*blah = $_[1];
}
...
}
I still use the ut pattern, when I'm developing a lot of code at once. But I don't mind writing
ut:dump_var( $var )
as opposed to saving 3-4 characters (because sometimes I call it U::).
Now, it appears that you don't want to do this long term, and dumping out your variables is a useful thing for development. If you really want to do this, Smart::Comments does it like so:
### #foo
### %bar
All it takes is one use statement.
use Smart::Comments;
Maybe just better to make another Package with Export and needed things?
Like, MyTest.pm:
package MyTest;
use strict;
use Carp;
use Data::Dumper;
use base qw( Exporter );
our #EXPORT = qw(
debug
)
sub debug {
carp Dumper #_;
}
1;
So you can then just write in your script:
use MyTest;
debug {a => 'b', c => 'd' }
Fun fact: Some symbols are magic in that they always refer to their values in the main package. You can assign subroutines to these symbols that and they will be visible in any package.
{
package Foo;
# special names _ ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT
sub ENV { print "In main::ENV ...\n" }
sub STDIN { print "In main::STDIN ...\n" }
sub _ { print "In main::_\n" }
# names that begin with ^ + upper case letter, or all digits
*{^T} = sub { scalar localtime };
*{^Gmtime} = sub { scalar gmtime };
*43 = sub { 42 };
use Data::Dumper;
*{^D} = \&Data::Dumper::Dumper;
}
{
package Bar;
&ENV;
STDIN();
print "The time is ", &^T, "\n";
print "In London it is ", &{^Gmtime}, "\n";
print "The answer is ", &43, "\n";
print "\#foo is ", &^D( \#foo );
}
None of this is recommended, unless you want to drive the next person who maintains your code insane.

How do I loop over all the methods of a class in Perl?

How do you loop over all the methods of a class in Perl? Are there any good online references to Perl introspection or reflection?
The recommendation Todd Gardner gave to use Moose is a good one, but the example code he chose isn't very helpful.
If you're inspecting a non-Moose using class, you'd do something like this:
use Some::Class;
use Class::MOP;
my $meta = Class::MOP::Class->initialize('Some::Class');
for my $meth ( $meta->get_all_methods ) {
print $meth->fully_qualified_name, "\n";
}
See the Class::MOP::Class docs for more details on how to do introspection.
You'll also note that I used Class::MOP instead of Moose. Class::MOP (MOP = Meta-Object Protocol) is the base on which Moose builds. If you're working with non-Moose classes, using Moose to introspect doesn't gain you anything.
If you wanted, you could use Moose () and Moose::Meta::Class->initialize instead of CMOP.
You can easily get a list of the defined methods of a class using the answers already provided. However, Perl is a dynamic language, which means more methods may be defined later. There really isn't a way to get a list of all of the methods to which any particular class will handle. For a lot more detail on this sort of stuff, I have a few chapters in Mastering Perl.
People are giving you (and upvoting) answers without telling you about the limitations.
Adam mentions his Class::Inspector, but it doesn't really work because it's trying to do something a dynamic language doesn't do (and that's be static :) For instance, here's a snippet where Class::Inspector returns no methods, but I can still call the VERSION method (as well as isa and can):
BEGIN {
package Foo;
our $VERSION = '1.23'
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports nothing
print Foo->VERSION, "\n";
Here's another case where I can call any method I like, but Class::Inspector only returns AUTOLOAD (and still missing VERSION, isa, and can):
BEGIN {
package Foo;
our $VERSION = '1.23';
my $object = bless {}, __PACKAGE__;
sub AUTOLOAD { $object }
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports only "AUTOLOAD"
print Foo->dog->cat->bird, "\n";
Curiously, everyone seems to ignore UNIVERSAL, probably because they don't explicitly handle it since it's only virtually in #ISA. I can add a debug method to every class, and Class::Inspector still misses it even though it's a defined method:
BEGIN {
sub UNIVERSAL::debug { "Hello debugger!\n" }
package Foo;
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # still reports nothing
print Foo->debug, "\n";
Class::MOP has the same limitations.
Not every module is going to use AUTOLOAD, but it's not an obscure or rare feature either. If you don't mind that you are going to miss some of the methods then Class::Inspector or Class::MOP might be okay. It's just not going to give you a list of every method you can call on a class or an object in every case.
If you have a class or an object and you want to know if you can call a particular method, use can(). Wrap it in an eval block so can can call can() on things that aren't even objects to still get back false, instead of death, in those cases:
if( eval { $object->can( 'method_name' ) } )
{
$object->( #args );
}
In the general case, you'll have to inspect the symbol table (unless you use Moose). For example, to list the methods defined in the IO::File package:
use IO::File;
no strict 'refs';
print join ', ', grep { defined &{"IO::File::$_"} } keys %{IO::File::};
The hash %{IO::File::} is the symbol table of the IO::File package, and the grep filters out non-subroutine entries (e.g. package variables).
To extend this to include inherited methods, you have to recursively search the symbol tables of the parent classes (#IO::File::ISA).
Here is a complete example:
sub list_methods_for_class {
my $class = shift;
eval "require $class";
no strict 'refs';
my #methods = grep { defined &{$class . "::$_"} } keys %{$class . "::"};
push #methods, list_methods_for_class($_) foreach #{$class . "::ISA"};
return #methods;
}
For more info on packages and symbol tables, see the perlmod man page.
Depends if you mean, any class, or if you were implementing your own. For the latter, I use Moose, which offers a very clean syntax for these features. From the cookbook:
my %attributes = %{ $self->meta->get_attribute_map };
for my $name ( sort keys %attributes ) {
my $attribute = $attributes{$name};
if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled')
# ... keeps on
You probably want Class::Inspector->methods('Your::Class').
Nuff said.
I'll just leave this here for when I forget it. This is extremely powerful; too bad it is so out of the way that most Perl programmers never get to experience it.
package Foo;
use strict;
sub foo1 {};
sub foo2 {};
our $foo3 = sub{};
my $foo4 = "hello, world!";
package Bar;
use strict;
# woo, we're javascript!
(sub {
*Bar::foo1 = sub { print "hi!"; };
*Bar::foo2 = sub { print "hello!"; };
$Bar::foo1 = 200;
})->();
package main;
use strict;
use Data::Dumper;
$Data::Dumper::Deparse = 1;
print Dumper \%Data::Dumper::;
print Dumper \%Foo::;
print Dumper \%Bar::;