Let's say I have a perl module file and I want to include and use it dynamically at runtime. Said module includes a class that I need to instantiate without knowing its name until runtime.
For example,
#inside module.pm
package module;
sub new {
#setup object
}
#inside main.pl
#get module.pm as argument
my $module_var = #load reference to module using text argument?
my $module_instance = $module_var->new();
This can be done without eval as follows:
my $module_name = 'Some::Module';
(my $require_name = $module_name . ".pm") =~ s{::}{/}g;
require $require_name;
my $obj = $module_name->new();
If you need to do this many times, just wrap up that code in a subroutine:
sub load_module {
for (#_) {
(my $file = "$_.pm") =~ s{::}{/}g;
require $file;
}
}
load_module 'Some::Module', 'Another::Module';
my $module_var = 'module';
eval "use $module_var; 1" or die $#;
my $module_instance = $module_var->new();
Note that the eval is a possible security hole. If $module_var contains code, it will get executed. One way around this is to use Class::MOP. Replace the eval line with:
use Class::MOP;
Class::MOP::load_class($module_var);
If you don't want to require Class::MOP, you could copy the _is_valid_class_name function from it into your code, and just make sure that $module_var contains a valid class before you eval it. (Note that if you're using Moose, you're already using Class::MOP behind-the-scenes.)
You can do this with eval.
my $module = "Foo";
eval "use $module;1" or die($#); # Couldn't load module
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 new to this site, so bear with me, If this question has already been answered somewhere else already. I am trying to call a subroutine "bar" from a module "codons1.pm" , and I encounter the error:
Can't locate object method "bar" via package "codons1.pm" (perhaps you forgot to load "codons1.pm"?). The main script looks like:
use strict;
use warnings;
my $i = 1;
my $pack = "codons$i\.pm";
require $pack;
(my %temp) = $pack->bar();
print keys %INC ;
Thanks to (Perl objects error: Can't locate object method via package) , I was able to verify using %INC, that the module is loaded.
The module looks like:
package codons1;
sub bar{ #some code;
return (%some_hash);}
1;
I am using $i so that I can load multiple similar modules via a loop. Any suggestions is welcome and thanks a lot, in advance.
Your package is codons1, and you're trying to call codons1.pm->bar. Either of the following will work correctly:
my $pack = "codons$i";
require "$pack.pm";
$pack->bar();
or
my $pack = "codons$i";
eval "require $pack";
$pack->bar();
A better way to do what you're trying to achieve
#!/usr/bin/perl
use strict;
use warnings;
package codons1;
sub new {
my $class = shift;
return bless {}, $class;
}
sub bar {
my %some_hash = (temperature=>"35");
return %some_hash;
}
1;
package main;
my $object = codons1->new(); #creates the object of codons1
my %temp = $object->bar(); #call the bar method from codons1's object
print keys %temp;
Demo
You need to learn basic object oriented programming in Perl. Start with perlootut, and then perlobj. Read the Object Oriented Perl chapter from freely available Beginning Perl book.
I am trying to make a library of functions for my oscilloscope, but I can't seem to get other module files to play nice.
What I have is here, except the Oscope.pm file. If it's needed I can upload it too.
test.pl
# Includes
use 5.012;
use Oscope;
use Oscope::Acquire;
use warnings;
# From Oscope.pm
my $scope = Oscope->new('port', 'COM3');
# From Oscope::Acquire.pm
$scope->QueryAcquire();
Oscope/Acquire.pm
package Oscope::Acquire;
use Oscope;
use parent 'Oscope';
sub QueryAcquire
{
my ($self) = #_;
# Oscope.pm
my $message = $self->Send('ACQUIRE?');
return();
}
1;
Output
Can't locate object method "QueryAcquire" via package "Oscope" at C:\Documents and Settings\ericfoss\My Documents\Slick\Perl\tests\Test.pl line 11.
Oscope->new('port', 'COM3')
should be
Oscope::Acquire->new('port', 'COM3')
I'm not going to say this is a good idea. You apparently want Oscope::Aquire to monkey patch Oscope. That is possible, but I would recommend having Oscope::Acquire export a function that takes an Oscope parameter (more information on exporting):
Oscope/Acquire.pm
package Oscope::Acquire;
require Exporter 'import';
#EXPORT_OK = qw{QueryAcquire};
use Oscope;
sub QueryAcquire
{
my ($oscope) = #_;
my $message = $oscope->Send('ACQUIRE?');
return $message;
}
1;
Which you would use:
use Oscope;
use Oscope::Acquire 'QueryAcquire';
my $oscope = Oscope->new();
print QueryAquire($oscope);
However, if you really want the $oscope->QueryAcquire() syntax, and you don't want to put it in Oscope itself, you can monkey patch the module. Perl documentation refers to this as modifying the module's symbol table through a typeglob and it's apparently deprecated ("The results of creating new symbol table entries directly ... are undefined and subject to change between releases of perl"):
Oscope/Acquire.pm
package Oscope::Acquire;
use Oscope;
*Oscope::QueryAcquire = sub {
my ($self) = #_;
my $message = $self->Send('ACQUIRE?');
return $message;
}
1;
I should have read my own link more closely. It appears that the approved way of doing this is to simply add methods to the Oscope package inside the Oscope/Acquire.pm file ("You can define a subroutine outside its package by explicitly qualifying the name of the subroutine"):
package Oscope::Acquire;
use Oscope;
...
sub Oscope::QueryAcquire {
my ($self) = #_;
my $message = $self->Send('ACQUIRE?');
return $message;
}
1;
That is, there's no need to the typeglob.
Where are your lib packages, place your code there. You could also use
use lib "path"
Another explanation can be found here which answers require over lib.
Your area message says it all in that it can't find the function.
As the code stands you could just say $scope->Oscope::Acquire::QueryAcquire();, but to get the desired effect, you need to make it part of the package.
package Oscope;
sub QueryAcquire
{
# Code here
}
1;
I am trying to create some scripts for web testing and I use the following piece of code to set up variables from a config file:
package setVariables;
sub readConfig{
open(FH, "workflows.config") or die $!;
while(<FH>)
{
($s_var, $s_val) = split("=", $_);
chomp($s_var);
chomp($s_val);
$args{$s_var} = $s_val;
print "set $s_var = $s_val\n";
}
close(FH);
}
for example: var1=val1
var2=val2
var3=val3
etc...
I want to be able to pass the values set by this subroutine to a subroutine in another package. This is what I have for the package I want it passed into.
package startTest;
use setVariables;
sub startTest{
my %args = %setVariables::args;
my $s_var = $setVariables::s_var;
my $s_val = $setVariables::s_var;
setVariables::readConfig(); #runs the readConfig sub to set variables
my $sel = Test::WWW::Selenium->new( host => "localhost",
port => 4444,
browser => $args{"browser"},
browser_url => $args{"url"} );
$sel->open_ok("/index.aspx");
$sel->set_speed($args{"speed"});
$sel->type_ok("userid", $args{"usrname"});
$sel->type_ok("password", $args{"passwd"});
$sel->click_ok("//button[\#value='Submit']");
$sel->wait_for_page_to_load_ok("30000");
sleep($args{"sleep"});
}
Unfortunately its not holding on to the variables as is and I don't know how to reference them.
Thank you for any help.
Your code has some problems. Let's fix those first.
# Package names should start with upper case unless they are pragmas.
package SetVariables;
# Do this EVERYWHERE. It will save you hours of debugging.
use strict;
use warnings;
sub readConfig{
# Use the three argument form of open()
open( my $fh, '<', "workflows.config")
or die "Error opening config file: $!\n";
my %config;
# Use an explicit variable rather than $_
while( my $line = <$fh> )
{
chomp $line; # One chomp of the line is sufficient.
($s_var, $s_val) = split "=", $line;
$config{$s_var} = $s_val;
print "set $s_var = $s_val\n";
}
close $fh;
return \%config;
}
Then use like so:
use SetVariables;
my $config = SetVariables::readConfig();
print "$_ is $config->{$_}\n"
for keys %$config;
But rather than do all this yourself, check out the many, many config file modules on CPAN. Consider Config::Any, Config::IniFiles, Config::JSON.
You note in your comment that you are trying to work with multiple files, your main code and a couple of packages.
One pattern that is common is to load your config in your main code and pass it (or select elements of it) to consuming code:
package LoadConfig;
sub read_config {
my $file = shift;
my $config;
# Do stuff to read a file into your config object;
return $config;
}
1;
Meanwhile in another file:
package DoStuff;
sub run_some_tests {
my $foo = shift;
my $bar = shift;
# Do stuff here
return;
}
sub do_junk {
my $config;
my $foo = $config->{foo};
# Do junk
return;
}
1;
And in your main script:
use DoStuff;
use LoadConfig;
my $config = LoadConfig::read_config('my_config_file.cfg');
run_some_tests( $config->{foo}, $config->{bar} );
do_junk( $config );
So in run_some_tests() I extract a couple elements from the config and pass them in individually. In do_junk() I just pass in the whole config variable.
Are your users going to see the configuration file or just programmers? If it's just programmers, put your configuration in a Perl module, then use use to import it.
The only reason to use a configuration file for only programmers if you are compiling the program. Since Perl programs are scripts, don't bother with the overhead of parsing a configuration file; just do it as Perl.
Unless it's for your users and its format is simpler than Perl.
PS: There's already a module called Config. Call yours My_config and load it like this:
use FindBin '$RealBin';
use lib $RealBin;
use My_config;
See:
perldoc FindBin
perldoc Config
I would suggest using a regular format, such as YAML, to store the configuration data. You can then use YAML::LoadFile to read back a hash reference of the configuration data and then use it.
Alternatively, if you don't want to use YAML or some other configuration format with pre-written modules, you'll need for your reading routine to actually return either a hash or a a hashref.
If you need some more background information, check out perlref, perlreftut and perlintro.
all you need to do is collect the variable in a hash and return a reference to it in readConfig:
my %vars = ( var1 => val1,
var2 => val2,
var3 => val3,
);
return \%vars;
and in startTest:
my $set_vars = setVariables::readConfig();
How could I access the symbol table for the current package an object was instantiated in? For example, I have something like this:
my $object = MyModule->new;
# this looks in the current package, to see if there's a function named run_me
# I'd like to know how to do this without passing a sub reference
$object->do_your_job;
If in the implementation of do_your_job I use __PACKAGE__, it will search in the MyModule package. How could I make it look in the right package?
EDIT:I'll try to make this clearer. Suppose I have the following code:
package MyMod;
sub new {
return bless {},$_[0]
}
sub do_your_job {
my $self = shift;
# of course find_package_of is fictional here
# just for this example's sake, $pkg should be main
my $pkg = find_package_of($self);
if(defined &{ $pkg . '::run_me' }) {
# the function exists, call it.
}
}
package main;
sub run_me {
print "x should run me.\n";
}
my $x = MyMod->new;
# this should find the run_me sub in the current package and invoke it.
$x->do_your_job;
Now, $x should somehow notice that main is the current package, and search it's symbol table. I tried using Scalar::Util's blessed , but it still gave me MyModule instead of main. Hopefully, this is a bit clearer now.
You just want caller
caller tells you the package from which it was called. (Here I added some standard perl.)
use Symbol qw<qualify_to_ref>;
#...
my $pkg = caller;
my $symb = qualify_to_ref( 'run_me', $pkg );
my $run_me = *{$symb}{CODE};
$run_me->() if defined $run_me;
To look it up and see if it's defined and then look it up to call it would duplicate it as standard perl doesn't do Common Subexpression Elimination, so you might as well 1) retrieve it, and 2) check definedness of the slot, and 3) run it if it is defined.
Now if you create an object in one package and use it in another, that's not going to be too much help. You would probably need to add an additional field like 'owning_package' in the constructor.
package MyMod;
#...
sub new {
#...
$self->{owning_package} = caller || 'main';
#...
}
Now $x->{owning_package} will contain 'main'.
See perldoc -f caller:
#!/usr/bin/perl
package A;
use strict; use warnings;
sub do_your_job {
my ($self) = #_;
my ($pkg) = caller;
if ( my $sub = $pkg->can('run_me') ) {
$sub->();
}
}
package B;
use strict; use warnings;
sub test {
A->do_your_job;
}
sub run_me {
print "No, you can't!\n";
}
package main;
use strict; use warnings;
B->test;
Output:
C:\Temp> h
No, you can't!