I am trying to Iterate directories in Perl, getting introspectable objects as result, mostly so I can print fields like mtime when I'm using Dumper on the returns from IO::All.
I have discovered, that it can be done, if in the module IO::All::File (for me, /usr/local/share/perl/5.10.1/IO/All/File.pm), I add the line field mtimef => undef;, and then modify its sub file so it runs $self->mtimef($self->mtime); (note, this field cannot have the same name (mtime) as the corresponding method/property, as those are dynamically assigned in IO::All). So, in essence, I'm not interested in "overloading", as in having the same name for multiple function signatures - I'd want to "replace" or "override" a class with its extended version (not sure how this is properly called), but under the same name; so all other classes that may use it, get on to using the extended version from that point on.
The best approach for me now would be, if I could somehow "replace" the IO::All::File class, from my actual "runnable" Perl script -- if somehow possible, by using the mechanisms for inheritance, so I can just add what is "extra". To show what I mean, here is an example:
use warnings;
use strict;
use Data::Dumper;
my #targetDirsToScan = ("./");
use IO::All -utf8 ; # Turn on utf8 for all io
# try to "replace" the IO::All::File class
{ # recursive inheritance!
package IO::All::File;
use IO::All::File -base;
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
return $self->_init;
}
1;
}
# main script start
my $io = io(#targetDirsToScan);
my #contents = $io->all(0); # Get all contents of dir
for my $contentry ( #contents ) {
print Dumper \%{*$contentry};
}
... which fails with "Recursive inheritance detected in package 'IO::All::Filesys' at /usr/local/share/perl/5.10.1/IO/All/Base.pm line 13."; if you comment out the "recursive inheritance" section, it all works.
I'm sort of clear on why this happens with this kind of syntax - however, is there a syntax, or a way, that can be used to "replace" a class with its extended version but of the same name, similar to how I've tried it above? Obviously, I want the same name, so that I wouldn't have to change anything in IO::All (or any other files in the package). Also, I would preferably do this in the "runner" Perl script (so that I can have everything in a single script file, and I don't have to maintain multiple files) - but if the only way possible is to have a separate .pm file, I'd like to know about it as well.
So, is there a technique I could use for something like this?
Well, I honestly have no idea what is going on, but I poked around with the code above, and it seems all that is required, is to remove the -base from the use IO::All::File statement; and the code otherwise seems to work as I expect it - that is, the package does get "overriden" - if you change this snippet in the code above:
# ...
{ # no more recursive inheritance!? IO::All::File gets overriden with this?!
package IO::All::File;
use IO::All::File; # -base; # just do not use `-base` here?!
# hacks work if directly in /usr/local/share/perl/5.10.1/IO/All/File.pm
field mtimef => undef; # hack
sub file {
my $self = shift;
bless $self, __PACKAGE__;
$self->name(shift) if #_;
$self->mtimef($self->mtime); # hack
print("!! *haxx0rz'd* file() reporting in\n");
return $self->_init;
}
1;
}
# ...
I found this so unbelievable, I even added the print() there to make sure it is the "overriden" function that runs, and sure enough, it is; this is what I get in output:
...
!! *haxx0rz'd* file() reporting in
$VAR1 = {
'_utf8' => 1,
'mtimef' => 1394828707,
'constructor' => sub { "DUMMY" },
'is_open' => 0,
'io_handle' => undef,
'name' => './test.blg',
'_encoding' => 'utf8',
'package' => 'IO::All'
};
...
... and sure enough,the field is there, as expected, too...
Well - I hope someone eventually puts a more qualified answer here; for the time being, I hope this is as good as a fix to my problems :) ...
Related
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.
I have a very interesting predicament. I am working on a Perl script interface to the CVS repository and have created Perl Objects to represent Modules,Paths, and Files. Since Modules, Paths, and Files can all have CVS commands issued on them, I set up the AUTOLOAD routine to take any unidentified methods and issue them on the object as if they were CVS commands.
All of these CVS commands are executed exactly the same way, but some of them need special processing done with the output to get the result i desire.
For example, I want to take the output from the diff command and reformat it before I return it.
I am using Moose, so typically this special processing could be done as follows:
after 'diff' => sub {
# Reformat output here
}
The problem is... I never explicitly created the diff method since it is being generated by AUTOLOAD and Perl won't let me create a method modifier for it since it technically doesn't exist!
Is there a way to get this to work how I want?
Apply after to your AUTOLOAD method.
after 'AUTOLOAD' => sub {
my $method = $The::Package::AUTOLOAD;
$method =~ s/.*:://;
if ($method eq 'diff') {
# do after diff stuff
} elsif ($method eq 'foo') {
# do after foo stuff
} else {
# never mind, don't want to do anything after this function
}
};
EDIT:
I found that I may want even more control over the diff command so I have added more detail to your answer. Hopefully someone will find this information useful.
For even more control you can use around!
around 'AUTOLOAD' => sub {
my $orig = shift;
my $self = shift;
(my $command = $AUTOLOAD) =~ s{.+::}{};
# Special processing
if ($command eq 'diff') {
#
# Add "before" special processing here
#
my $output = $self->$orig(#_);
#
# Add "after" special processing here
#
}
else {
return $self->$orig(#_);
}
};
This allows you to do special processing before the function is called AND after.
For more information see: Moose::Manual::MethodModifiers
Depending on how well the AUTOLOAD-using class is implemented, you may find that it respects the can method too, and that simply calling can is enough to create the method.
__PACKAGE__->can( "diff" );
after diff => sub { ... };
I'd suggest that you re-architect your system to use traits, instead of relying on AUTOLOAD behavior. The maintainability and intent will be much more obvious, if you don't have behavior scattered all over the place.
As an example, you can do what you want with something like the following:
package Trait::CVSActions;
use Moose::Role;
sub commit { print 'in commit for ' . shift . "\n" }
sub diff { print 'diffing for ' . shift . "\n" }
package Module;
use Moose;
with 'Trait::CVSActions';
package Path;
use Moose;
with 'Trait::CVSActions';
after commit => sub { print "after commit on Path\n" };
package main;
my $module = new Module;
my $path = new Path;
$module->commit;
$path->commit;
If you're looking to use AUTOLOAD to dispatch to unknown commands, then this is dangerous, since there may be some that you will have to have special handling for that you aren't aware of, so you may be causing yourself future problems.
Have this working short code
use 5.014;
package Module;
use warnings;
use Moose;
use Method::Signatures::Simple;
has 'commands' => (
is => 'ro',
isa => 'HashRef',
default => sub{{
open => 'my_open',
close => 'my_close',
}},
);
method run($cmd, $args) {
my $met = $self->commands->{$cmd} if exists $self->commands->{$cmd};
$self->$met($args) if $met;
#-----
#how to write the above two lines in one command?
#the next doesn't works
# $self->commands->{$cmd}($args) if exists $self->commands->{$cmd};
#-----
}
method my_open { say "module: open" }
method my_close { say "module: close" }
package main;
my $ef = Module->new();
$ef->run('open');
The main question is in the code - how to write in one line the "run" method - without the helper variable $met.
And, is here better way to do the above scenario - so calling methods based on input?
First of all, please don't do my $foo = $x if $y. You get unexpected and undefined behavior, so it is best to avoid that syntax.
The piece of code
my $met = $self->commands->{$cmd} if exists $self->commands->{$cmd};
$self->$met($args) if $met;
is equivalent to
if (my $met = $self->commands->{$cmd}) {
$self->$met($args);
}
because the exists test is superfluous here (an entry can only be true if it exists).
If we do not wish to introduce another variable, we have two options:
Trick around with $_:
$_ and $self->$_($args) for $self->commands->{$cmd};
This uses the for not as a loop, but as a topicalizer.
Trick around with scalar references:
$self->${\( $self->commands->{$cmd} )}($args) if $self->commands->{$cmd};
or
$self->${\( $self->commands->{$cmd} || "no_op" )}($args);
...
method no_op { }
Don't do something like this, because it is impossible-to-read line noise.
Neither of these is particularly elegant, and it would be better to use the cleaned-up solution I have shown above.
Just because something can be done in a single line does not mean it should be done. “This is Perl, not … oh, nevermind”.
I have the following problem, may be I am trying to solve it in a bad way so if you tell me how to do it in a right way I would be very grateful!
I have a base class which has a method which I want to access to a package variable based on real object class (ref($self)).
#!/usr/bin/env perl
my $var = SubClass->new();
$var->method();
package BaseClass;
sub new { construct... }
sub method {
my $self = shift;
# in this method I wan to get values from 'our %VAR' of the children class or ref($self) class, something like that:
return ${ref($self)::VAR}{k1};
# of course I can create a method and do it in the following way but I am not sure that it's a good idea
return $self->get_var()->{k1};
}
sub get_var { die "Imaplement in children"; }
package SubClass;
use base 'BaseClass';
our %VAR = (k1 => 'smth', k2 => 'smth', ...);
sub get_var { return \%VAR } # don't like this idea
1;
Using the %{ref($self)::VAR} solution may sometimes be the easiest, although a paranoid programmer would include some checks:
# Accessing %__PACKAGE__::VAR:
# I hope that I'm not in a subclass,
# because that would change the value reported by `ref($self)`
# and I can't be bothered to search #ISA manually...
unless (defined ref $self) {
die "\$self is not a reference!";
}
if (ref $self ~~ [qw/SCALAR ARRAY HASH
CODE REF GLOB LVALUE FORMAT IO VSTRING Regexp /]) {
die "\$self is not an object!";
}
no strict 'refs'; # Hehe, I can't use strict here :S
unless (%{ref($self).'::VAR'}) {
warn "Umm, this hash is empty."
. "I don't know if I just created it, or it is meant to be that way.";
}
return ${ref($self).'::VAR'}{k1};
In conclusion, using an accessor method does not only save us repetition, it is also safer, less hackish and far more object oriented:
sub return_var {
# We know that we are in the right package.
# We know we are accessing the correct hash.
# It is irrelevant whether I call this method
# from the package/class or from an object.
# And I'm glad to take the method performance penalty
# in exchange for clear code.
return \%VAR;
}
In conclusion #2, there is more than one way to do it. And in Perl, there is no "right" way. Although you might understand why I find the second solution more elegant.
I'm a bit messed up with the following:
I have a function that calls subroutines in the following way:
sub someFunction {
my $self = shift;
my $type = $self->{'type'};
if($type eq 'one_subroutine') {
$self->updateOneSubroutine();
}
elsif($type eq 'another_one_sub') {
$self->updateAnotherOneSub();
}
(...)
else {
die "Unsupported '$type'";
}
I have to change this to let each subroutine be coded in its own file, include all available files, and automagically call the subroutine inside.
I did this in a test file with the following code:
# Assume a routines subdir with one_subroutine.pm file with
sub updateOneSubroutine(){
$self = shift;
$self->doSomeThings();
(...) #my code
}
1;
test.pl
# Saves in routines hash_ref a pair of file_name => subRoutineName for each file in routines subdir.
# This will be used later to call subroutine.
opendir(DIR,"lib/routines") or die "routines directory not found";
for my $filename (readdir(DIR)) {
if($filename=~m/\.pm$/){
# includes file
require "lib/routines/$filename";
# get rid of file extension
$filename=~s/(.*)\.pm/$1/g;
my $subroutine = "update_${file}";
# camelizes the subroutine name
$subroutine=~s/_([a-z0-9])/\u$1/g;
$routine->{ $filename } = $subroutine;
}
}
{
no strict "refs";
$routine->{$param}();
}
where param is something like "one_subroutine", that matches with a filename available.
Since each subroutine receives $self in the call, I should call the routine by $self->something();
I've tried $self->$routine->{$param}() , $self->${routine->${param}}() and many other things without success. I've checked chapter 9 "dynamic subroutines" of mastering perl, and a similar question to perl monks, but I can't still figure out how to reference the subroutine in a way that represents $self->updateAnotherOneSub() , or something similar that lets $self be read as a param in those subroutines.
Thanks in advance, Keber.
This seems a bit like an X/Y problem. What exactly are you trying to do? If it is to reduce loading time, then modules like AutoSplit/AutoLoader might be of interest to you.
If it is to create some sort of data structure of subroutines, you should be installing anonymous subs into a hash, rather than giving them all names.
Given a subroutine reference:
my $code = sub {...};
you would call it as:
$self->$code(...);
If instead you have a subroutine name, you can lookup the coderef:
my $code = 'Package::With::The::Subroutines'->can('method_name');
and if that succeeds (check it), then you can use $self->$code(...) to call it.
Given this code:
{
no strict "refs";
$routine->{$param}();
}
You would pass $self to the routine with:
{
no strict "refs";
$routine->{$param}($self);
}
Or you could approach it the way I did above with can:
'package'->can($routine->{$param})->($self)
if you don't want to turn off strict 'refs'
Try to extract the method name first, then it should work. I did a small test script that may do something like you want to, so:
my $method = $routine->{$param};
$self->$method->();
You can and of course should check, if the desired method exists like Eric said:
if ($self->can($method)) {
$self->$method->();
}
The important part here is, that you extract the method name so you have it in a single variable; otherwise perl won't figure that out for you - and as far as I know there is no way of setting parens or braces to do so.