I have a module misc which is used by a few scripts. Each script accept two standard options (-help and -verbose) as well as a bunch of its own ones.
So, every scripts now has
my ($verbose,$quiet) = (1,0);
my $help = undef;
...
GetOptions("verbose|v+" => \$verbose, "quiet|q+" => \$quiet, "help|h" => \$help,
....)
or die "GetOptions: error (see above)\n";
if (defined $help) { usage(); exit; }
$verbose -= $quiet;
which is already boring.
Now, I want the misc functions to be aware of the value of $verbose too, so I have to move $verbose et al to misc and use $misc::verbose in scripts:
misc:
our $verbose = 1;
my $quiet = 0;
our $help = undef;
our %common_options = ("verbose|v+" => \$verbose, "quiet|q+" => \$quiet, "help|h" => \$help);
sub set_verbose () { $verbose -= $quiet; }
script:
GetOptions(\%misc::common_options,"verbose|v","quiet|q","help|h",
"count=i" => \$count, "start=i" => \$start, "mincoverage=i" => \$mincoverage,
"output=s" => \$output, "input=s" => \$input, "targets=s" => \$targets)
or die "GetOptions: error (see above)\n";
if (defined $misc::help) { usage(); exit; }
misc::set_verbose();
which does not look much better (and appears to not work anyway, at least -help is ignored).
So, what do people use for command line options shared between modules and scripts?
Personally, I do it simpler:
use a hash to store command line options
GetOptions(\%args, "xxx1","xxx2");
Pass that hash - as is - to ANY classes' constructrs, or module setters
my $object = Class1->new(%args, %constructor_args);
Module2::set_args(\%args); #
Argument setter in the module would be:
# Module2
our %args;
sub set_args { %args = %{ shift }; }
This ensures that:
I NEVER have to worry about moving parameters from scope to scope and having to modify some calls. They are ALL passed around 100% of needed places
Neat and non-messy code. Since we are broadcasting, we don't need to worry about subscribers' individual needs.
Pattern easily replicated to ALL classes you own.
As a matter of fact, if you want to be extra crafty, you can even replace Module2::set_args(\%args); calls for several classes with a smart code that:
Reads in a list of loaded modules
Checks which of those modules implements set_args() call via UNIVERSAL::can()
Calls the supporting modules' set_args() call
The latter makes the code even cleaner, in that N calls to set_args() one for each non-class module is are all replaced by one set_all_modules_args() call.
Have a module that's responsible for getting standard options.
Use this module, and everyone will be able to access the verbose() call.
package StandardOptions;
use base qw(Exporter);
our #EXPORT = qw(verbose);
use Getopt::Long;
Getopt::Long::Configure(qw(pass_through));
my $helpNeeded;
my $verbose
GetOptions ("help" => \$helpNeeded, "verbose" => $verbose);
if ($helpNeeded) {
#provide help
exit(0);
}
sub verbose {
return $verbose;
}
1;
Related
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.)
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 :) ...
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 want to use Perl module and wrap it into a standalone socket which would publish the subroutines from the module to other programmes. However, I probably cannot overcome namespace issues, since in the client script, I am still getting an error message:
RPC::Serialized::X::Application\',\'MESSAGE\' => \'No handler for 'predejPOS' .
My server script:
use RPC::Serialized::Server::NetServer::Single;
use RPC::Serialized::Handler::HashTree;
my $s = RPC::Serialized::Server::NetServer::Single->new({
net_server => {log_file => '', port => 20203 },
rpc_serialized => {handler_namespaces => ''},
});
$s->run;
My client script:
use RPC::Serialized::Client::INET;
my $client = RPC::Serialized::Client::INET->new({
io_socket_inet => {PeerAddr => '127.0.0.1', PeerPort => 20203,}
});
my $result = $client->predejPOS('flu-like');
My module (HastTree.pm):
package RPC::Serialized::Handler::HashTree;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(predejPOS);
use base 'RPC::Serialized::Handler';
our $VERSION = '0.01';
sub predejPOS {
my %POS;
$POS{'flu-like'}='<JJ>';
return $POS{$_[0]};
};
1;
I am using Windows 7, Strawberry Perl 5.12.3, and the module sits on the correct address
(C:\PROGS\Strawberry\perl\site\lib\RPC\Serialized\Handler). The function predejPOS is recognised inside the server script (ie. I can print its result from it), but I cannot access it through the client-server communication. I assume that it has something to do with the subtle difference between calling the function and calling the method. I am afraid that it is probably something simple, but even after a substantial effort and googling I was not able to make it work.
Thanks in advance!
Well I eventually solved it by myself:
First, I got completely wrong the concept of calling functions - over the network you can only call so called RPC Handlers. Moreover for each handler there must be a module in RPC::Serialized::Handler directory with the same name and a specific structure with only one subroutine inside called invoke(). Thus I changed my module (named now 'PredejPOS.pm') to:
package RPC::Serialized::Handler::PredejPOS;
{
$RPC::Serialized::Handler::PredejPOS::VERSION = '0.01';
}
use strict;
use warnings FATAL => 'all';
use base 'RPC::Serialized::Handler';
sub invoke {
my $self = shift;
my $key = shift;
my %POS;
$POS{'flu-like'}='<JJ>';
return scalar $POS{$key};
}
1;
But it was still not working.
Finally secondly I found that under Windows environment, the Perl Data::Serialize module does not work properly.
In the package Serialized.pm, subroutine recv (row 115), the chomp does not remove the damned Windows line ending '\cM'. When I corrected it, it started working as envisaged. Actually there is a lenghty discussion of this behaviour here ( http://www.perlmonks.org/?node_id=549385 )
Thanks for the suggestions.
For object method the first argument is always the current object instance itself. Sorry, if I am not clear enough, try to figure out the difference from this example:
Try this:
sub predejPOS {
my $self = shift;
my $key = shift;
my %POS;
$POS{'flu-like'}='<JJ>';
return $POS{$key};
};
I have a perl script that uses the CGI::Session::Drive::memcached, but I want to be able to fallback on the default Session driver or another driver if it's available on the system...
This is how I started off using Memcache, but this doesnt necessarily solve the problem of the case when Cache::Memecached and/or CGI::Session::Driver::memcached are not available...
package MySession;
use Moose::Role;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
use CGI::Session ('-ip_match');
use CGI::Session::Driver::memcached;
use Cache::Memcached::Fast;
#would be nice to create this conditionally, or use a delegate maybe
has 'memeCached' => (
is => 'rw',
isa => 'Maybe[Cache::Memcached::Fast]',
default => sub{ return Cache::Memcached::Fast->new( {'servers' => [ '10.x.x.x.:10001' ],'compress_threshold' => '100000','nowait' => 1,'utf8' => 1} ) },
);
sub buildSession{
my($this,$cgi,$sessionDir) = #_;
$cgi = $cgi || $this->getCGI();
my $sid = $this->SID();
my $mem = $this->memeCached();
my $sss;
if(!$mem){
$sss = CGI::Session->load(undef, $cgi, {Directory=>$sessionDir}) or die CGI::Session->errstr();
}else{
$sss = CGI::Session->load( "driver:memcached", $cgi, { Memcached => $mem }) or die CGI::Session->errstr();
}
...
Then this got me thinking, how do I do this -- in a general sense? or what's the best way to do this (especially using Moose)?
I had a similar situation. We use Windows domains, which I can connect to Net::LDAP. In my program, I want to be able to take the user ID jsmith, and instead of printing on the user ID, I want to be able to print out the name John Smith.
Many people at my company use my program, but not all are Perl experts and most wouldn't know how to install a Perl module. And, since Net::LDAP is not a standard module, many people don't have it.
Instead, I wanted a fallback routine. If I could look up the name with Net::LDAP, I would print the name, if I couldn't load Net::LDAP, I would fallback and just print the user ID.
I used the following for testing if Net::LDAP was installed, and load it if possible:
BEGIN {
eval { require Net::LDAP; };
our $Net_Ldap_Status = 1 if (not $#);
}
What you have to understand is that:
use Foo::Bar;
is the same as:
BEGIN {
require Foo::Bar;
}
It loads in the module at compile time. By surrounding the require with an eval I can test whether the statement succeeds (and the module is loaded) or fails (the module doesn't load, but the program doesn't crash either.) I can then check $# to see if the module loaded or not. $# is the error message that eval sets. If $# is null, then the module exists and was loaded successfully.
I need to use a package variable (the our $Net_Ldap_Status instead of my $Net_Ldap_Status) or the variable will be lost when the program runs. (I'm not even sure if my $Net_Ldap_Status would work in a BEGIN statement).
Now, here's where things get funky...
When I need to check $Net_Ldap_Status, I need to redeclare it:
our $Net_Ldap_Status;
or I tend to get that non-declared variable error. The funny thing is that it doesn't lose its previous value by redeclaring it. Thus, somewhere in my code is:
our $Net_Ldap_Status;
if ($Net_Ldap_Status) {
print "Code if Net::LDAP is loaded.\n";
}
else {
print "Fallback Code if no Net::LDAP\n";
}