The autodie documentation hints that it is possible to use it for other functions than those built-ins which it can handle by default, but there are no clear examples how to do that in it.
Specifically I would like to use it for the Imager module. A lot of the functions and methods of that can fail, and I would prefer if that wouldn't mean that my code will be littered with or die Imager|$image->errstr; phrases all over.
Of course, if there's another way than using autodie to achieve that, I would be interested in that too.
autodie only works with functions, not methods. This is because it's lexically scoped, and method lookup can't be lexically scoped. autodie::hints explains how to tell autodie about user-defined functions, but that won't do anything for methods.
I don't know of any way to get autodie-like behavior for methods, unless the module has that built in (e.g. DBI's RaiseError).
You could have a subroutine to do the check, but it wouldn't save all that much code, since you'd still have to pass it the correct object or class to call errstr on.
See autodie::hints
Here is an alternative technique that works with methods:
package SafeCall;
use Carp ();
sub AUTOLOAD {
my ($method) = our $AUTOLOAD =~ /([^:']+)$/; #'
unshift #_, my $obj = ${shift #_};
my $code = $obj->can($method)
or Carp::croak "no method '$method' on $obj";
&$code or Carp::croak $obj->can('errstr')
? $obj->errstr
: "calling $method on $obj failed"
}
And to use it:
package Image;
sub new {bless {here => 'ok', also => 'can be looked up'}};
sub fails {$_[0]{not_here}}
sub succeeds {$_[0]{here}}
sub lookup {$_[0]{$_[1]}}
sub errstr {'an error occurred'}
package main;
use 5.010; # for say()
my $safe = sub {bless \$_[0] => 'SafeCall'};
# storing the constructor in the scalar $safe allows $safe to be used
# as a method: $obj->$safe->method
my $img = Image->new;
say $img->$safe->succeeds; # prints 'ok'
say $safe->($img)->succeeds; # or call this way (also prints 'ok')
say $img->$safe->lookup('also'); # prints 'can be looked up'
say $img->$safe->fails; # dies with 'an error occurred at file.pl line ##'
Related
If I pass it as an argument I get the error:
'Can't locate object method "getline" via package "Bad" at Bad.pm line 27.'
But if I insert it in the module it works.
This is the boiled down code. bad.pl uses the module Bad.pm. Set $CAUSE_ERROR to see the problem.
#!/usr/bin/env perl
# This is bad.pl
use strict;
use warnings;
use IO::File;
use Bad; # use the bad module "Bad.pm"
&Main();
sub Main {
my $filename = "bad.pl";
warn "About to parse '$filename'\n";
my $MyWord = Bad->new(); # Create a new object.
my $io = IO::File->new($filename, "r");
#####################
my $CAUSE_ERROR = 1; # Set to 0 it does NOT cause an error. Set to 1 it DOES.
#####################
if($CAUSE_ERROR ) {
$MyWord->Parse($MyWord, $io);
} else {
$MyWord->{fd} = $io;
$MyWord->Parse($MyWord);
}
}
This is Bad.pm
package Bad;
# This is Bad.pm
use warnings;
use strict;
sub new {
my ($class, $args) = #_;
my $self = {
fd => undef,
};
return bless($self, $class); # Changes a function to a class
}
sub Parse {
my ($MyWord, $io) = #_;
if(defined($MyWord->{fd})){
# WORKS
$io = $MyWord->{fd};
while ( defined(my $inputline = $io->getline) ) {
print "${inputline}";
}
} else {
# FAILS
while ( defined(my $inputline = $io->getline) ) {
print "${inputline}";
}
}
}
1;
Using Perl v5.22.3 under Cygwin.
Originally I had Bad.pm in a sub directory but I simplified it.
Thank you for you time.
To summarize:
$MyWord->Parse($MyWord, $io);
Given that $MyWord is a reference blessed into the Bad class (i.e, it's an instance of Bad), this calls Bad::Parse with the arguments ($MyWord, $MyWord, $io). That is, it behaves as if you'd called:
Bad::Parse($MyWord, $MyWord, $io)`.
However, Bad::Parse() is written to expect the arguments ($MyWord, $io), so $io gets set to the second $MyWord, and Bad::Parse() throws an error when it tries to call $io->getline because the Bad module doesn't implement that method.
The fix is simple:
Call the function as $MyWord->Parse($io).
Change the variable name for the first argument in Bad::Parse() from $MyWord to $self. This isn't strictly necessary -- you can technically call this variable whatever you want -- but it's conventional, and will make your code much more readable to other Perl programmers.
To summarize errors in the posted code: The class name is passed to the constructor behind the scenes, as is the object to methods; we do not supply them. We do pass the filehandle to new, so that it is assigned to object's data and it can thus be used by methods in the class.
Here is a basic example. I try to stick to the posted design as much as possible. This does not do much of what is needed with I/O objects, but is rather about writing a class in general.
The class is meant to process a file, having been passed a filehandle for it. We expect to have one filehandle per object. Since we get it open the reponsibility to close it is left to the caller.
script.pl
use strict;
use warnings;
use feature 'say';
use IO::File;
use ProcessFile;
my $filename = shift || $0; # from command line, or this file
say "About to parse '$filename'";
my $io = IO::File->new($filename, "r") or die "Can't open $filename: $!";
my $word = ProcessFile->new($io); # Create a new object, initialize with $io
$word->parse();
# OR, by chaining calls
#my $word = ProcessFile->new($io)->parse();
say "Have ", ProcessFile->num_objects(), " open filehandles";
$io->close;
The package file ProcessFile.pm
package ProcessFile;
use warnings;
use strict;
use Carp qw(croak);
use Scalar::Util qw(openhandle);
# Example of "Class" data and methods: how many objects (open filehandles)
our $NumObjects;
sub num_objects { return $NumObjects }
sub DESTROY { --$NumObjects }
sub new {
my ($class, $fh) = #_; # class name, arguments passed to constructor
# To also check the mode (must be opened for reading) use Fcntl module
croak "No filehandle or not open or invalid " if not openhandle $fh;
my $self = { _fh => $fh }; # add other data that may make sense
bless $self, $class; # now $self is an object of class ProcessFile
++$NumObjects;
return $self;
}
sub parse {
my ($self, #args) = #_; # object, arguments passed to method (if any)
# Filehandle is retrieved from data, $self->{_fh}
while ( defined(my $inputline = $self->{_fh}->getline) ) {
print $inputline;
}
# Rewind before returning $self (or not, depending on design/#args)
# Can do more here, set some data etc, as needed by class design
seek $self->{_fh}, 0, 0;
return $self;
}
1;
A few comments on the above code follow. Let me know if more would be helpful.
Class data and methods don't belong to any one object, and are used for purposes that relate to the class as a whole (for example, to track all objects in play).
The DESTROY method runs when an object is destroyed, for example when it goes out of scope. Here we need it in order to decrease the count of existing objects. Try: place the code creating an object in a block { ... }; and see what count we get after the block.
We use openhandle from Scalar::Util to test whether the filehandle is open. We should really also test whether it is open for reading, since that is the fixed purpose of the class, using Fcntl.
In the sole, example method parse we read out the file and then rewind the filehandle, before returning the object. That is a placeholder for saving and/or setting the state for repeated use. What is done depends on the purpose and design of the class, and can be controlled by arguments.
Documentation: tutorial perlootut and reference perlobj on object-oriented work in Perl, perlmod for modules (a class is firstly a package), and a tutorial perlreftut for references.
There are also many informative SO posts around, please search.
i am switching my application from Perl 5.8.8 to Perl 5.16.3 and now i get tons of warnings about the following third party code in SOAP::Lite
unless (defined %{"$protocol_class\::Client::" )
The code produces the following warings:
Warning in Perl code: \t(Maybe you should just omit the defined()?)
Warning in Perl code: defined(%hash) is deprecated at /.../SOAP/Lite.pm
line ...
If i reduce it to a simple example it looks like
unless( defined %{"some::string"} )
Question: Why should someone interpret a string "some::string" as a hash %{"some::string"} and check if the hash is defined? It doen't make any sense to me. I want to replace this codepiece with something else without breaking the third party module so i can focus on real important warnings and errors.
Here is the whole function. I don't know if this helps because think its some kind of Guru code which is a little bit hard to understand
sub proxy {
my $self = shift;
$self = $self->new() if not ref $self;
my $class = ref $self;
return $self->{_proxy} unless #_;
$_[0] =~ /^(\w+):/ or die "proxy: transport protocol not specified\n";
my $protocol = uc "$1"; # untainted now
# HTTPS is handled by HTTP class
$protocol =~s/^HTTPS$/HTTP/;
(my $protocol_class = "${class}::$protocol") =~ s/-/_/g;
no strict 'refs';
unless (defined %{"$protocol_class\::Client::"}
&& UNIVERSAL::can("$protocol_class\::Client" => 'new')
) {
eval "require $protocol_class";
die "Unsupported protocol '$protocol'\n"
if $# =~ m!^Can\'t locate SOAP/Transport/!;
die if $#;
}
$protocol_class .= "::Client";
return $self->{_proxy} = $protocol_class->new(endpoint => shift, #_);
}
The construct %Package:: gives access to a package's stash, i.e. the symbol table hash.
All this code is doing is checking whether a given package has been loaded (in which case its stash will exist) and that there is a new method for the package. If not then require is used to load the module.
The call to UNIVERSAL::can('package', 'method') is normally written as 'package'->can('method') and you can change that here if you like, but the code will work as it stands.
I suggest you do just as the warnings say, and omit the defined. It would also be nicer if you put the package name in its own variable instead of using the interpolated double-quoted string twice, and you can use the conventional call to can as I have described. It would look like this
my $package = "${protocol_class}::Client";
unless ( %{"${package}::"} and $package->can('new') ) {
# load missing module
}
I'm using dynamic multilevel hashes from which I read data but also writes data.
A common pitfall for me is accessing non-existing keys (typos, db revisions etc.). I get undefs which propagate to other parts and cause problems. I would like to die whenever I try to read a non-existing key, but still be allowed to add new keys.
So the wanted behavior is:
my %hash;
$hash{A} = 5; # ok
print $hash{A}, "\n"; # ok
print $hash{X}, "\n"; # should die
$hash{B}{C}{D} = 10; # ok
print $hash{B}{C}{X}, "\n"; # should die
I previously posted a similar question and got great answers. I especially like the accepted one, which allows using the normal hash syntax. The only problem is I'm not sure how to easily generalize this to deep hashes as in the example above.
p.s.
I find this feature really useful and I wonder if I'm missing something, since it does not seem very popular. Perhaps it is not common to read/write from/to the same hash?
With warnings pragma switched on then you do get Use of uninitialized value in print at... warnings at the two lines you want to die.
So if you make warnings fatal then they would die instead:
use warnings FATAL => 'all';
Update
Based on comments you've made I assume your common case issue is something along these lines:
my $x = $hash{B}{C}{X};
Which won't throw warning/error until you actually use $x later on.
To get around this then you can do:
my $x = $hash{B}{C}{X} // 'some default value';
my $z = $hash{B}{C}{Z} // die "Invalid hash value";
Unfortunately the above would mean a lot of extra typing :(
Here is at least a short cut:
use 5.012;
use warnings FATAL => 'all';
use Carp 'croak';
# Value Or Croak!
sub voc { $_[0] // croak "Invalid hash" }
Then below would croak!
my $x = voc $hash{B}{C}{X};
Hopefully this and also the fatal warnings are helpful to you.
/I3az/
It's late for me so I'll be brief, but you could do this using the tie functionality -- have your hash represented by an object underneath, and implement the functions needed to interact with the hash.
Check out perldoc -f tie; there are also many classes on CPAN to look at, including Tie::Hash itself which is a good base class for tied hashes which you could build on, overriding a few methods to add your error checking.
If you want to wrap checks around a hash, create a subroutine to do it and use it as your interface:
use 5.010;
use Carp qw(croak);
sub read_from_hash {
my( $hash, #keys ) = #_;
return check_hash( $hash, #keys ) // croak ...;
}
But now you're starting to look like a class. When you need specialized behavior, start writing object-oriented classes. Do whatever you need to do. That's the part you're missing, I think.
The problem with sticking to the hash interface is that people expect the hash syntax to act as normal hashes. When you change that behavior, other people are going to have a tough time figuring out what's going on and why.
If you don't know what keys the hash might have, use one of the tied hash suggestions or just turn on warnings. Be aware that tying is very slow, nine times slower than a regular hash and three times slower than an object.
If you have a fixed set of possible keys, what you want is a restricted hash. A restricted hash will only allow you to access a given set of keys and will throw an error if you try to access anything else. It can also recurse. This is much faster than tying.
Otherwise, I would suggest turning your data into an object with methods rather than direct hash accesses. This is slower than a hash or restricted hash, but faster than a tied hash. There are many modules on CPAN to generate methods for you starting with Class::Accessor.
If your data is not fixed, you can write simple get() and set() methods like so:
package Safe::Hash;
use strict;
use warnings;
use Carp;
sub new {
my $class = shift;
my $self = shift || {};
return bless $self, $class;
}
sub get {
my($self, $key) = #_;
croak "$key has no value" unless exists $self->{$key};
return $self->{$key};
}
sub set {
my($self, $key, $value) = #_;
$self->{$key} = $value;
return;
}
You can get recursive behavior by storing objects in objects.
my $inner = Safe::Hash->new({ foo => 42 });
my $outer = Safe::Hash->new({ bar => 23 });
$outer->set( inner => $inner );
print $outer->get("inner")->get("foo");
Finally, since you mentioned db revisions, if your data is being read from a database then you will want to look into an object relation mapper (ORM) to generate classes and objects and SQL statements for you. DBIx::Class and Rose::DB::Object are two good examples.
Use DiveDie from Data::Diver:
use Data::Diver qw(DiveDie);
my $href = { a => { g => 4}, b => 2 };
print DiveDie($href, qw(a g)), "\n"; # prints "4"
print DiveDie($href, qw(c)), "\n"; # dies
re: your comment - hints on how to get the recursive effect on Ether's tie answer.
I'ts not for the fainthearted, but below is a basic example of one way that you might do what you're after by using Tie::Hash:
HashX.pm
package HashX;
use 5.012;
use warnings FATAL => 'all';
use Carp 'croak';
use Tie::Hash;
use base 'Tie::StdHash';
sub import {
no strict 'refs';
*{caller . '::hash'} = sub {
tie my %h, 'HashX', #_;
\%h;
}
}
sub TIEHASH {
my $class = shift;
croak "Please define a structure!" unless #_;
bless { #_ }, $class;
}
sub STORE {
my ($self, $key, $value) = #_;
croak "Invalid hash key used to store a value" unless exists $self->{$key};
$self->{$key} = $value;
}
sub FETCH {
my ($self, $key) = #_;
exists $self->{$key}
? $self->{$key}
: croak "Invalid hash key used to fetch a value";
}
1;
Above module is like a strict hash. You have to declare the hash structure up front then any FETCH or STORE will croak unless the hash key does exist.
The module has a simple hash function which is imported into calling program and is used to build the necessary tie for everything to work.
use 5.012;
use warnings;
use HashX;
# all my hashref are ties by using hash()
my $hash = hash(
a => hash(
b => hash(
c => undef,
),
),
);
$hash->{a}{b}{c} = 1; # ok
$hash->{a}{b}{c} = 2; # also ok!
$hash->{a}{b}{d} = 3; # throws error
my $x = $hash->{a}{b}{x}; # ditto
Remember this is a quick & dirty example and is untested beyond above. I'm hoping it will give you the idea of how it could be done using Tie::Hash and even whether it's worth attempting :)
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::;
Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.