How to import subroutines from modules in perl - perl

I am novice in perl. I have this sample code.
#! /usr/bin/perl
# Calcu.pm
package Calc;
sub add {
( $one , $two ) = #_;
$total = $one + $two;
return $total;
}
1;
&
#! /usr/bin/perl
# add.pl
use Calcu;
print Calcu::add(50, 60);
script add.pl is running fine. but I want to call the add method without mentioning its module name. I googled & added below lines in my Calcu.pm
use Exporter;
#ISA = (Exporter);
#EXPORT = qw (add);
& replace print Calcu::add(50, 60); with print add(50, 60); in add.pl but it is still giving me the below error.
Undefined subroutine &main::add called at add.pl
Is there any way possible so that I can directly call add subroutine in my ad.pl?

Change package Calc; to package Calcu; in Calcu.pm
The mismatch in package names is what is giving you trouble.
Have a read through perldoc Exporter for the gory details.
Have a look at perldoc perlootut for an overview of different ways in perl to create objects.

Related

get all possible permutations of words in string using perl script

I have a string like this , how are you , I want to get all possible shuffle of word like
how are you
are how you
you how are
you are how
are you how
how you are
How can I make it in perl script , i've tried the shuffle function but it returns only one string of shuffle .
If you are not familiar with Perl script, you can tell me the logic only.
Note: The words count in string are not constant.
What you're talking about are permutations. This can be done in Perl with the Algorithm::Permute module:
If you've installed the module, here's a shell one-liner that will do it for you:
perl -e'
use Algorithm::Permute qw();
my $str = $ARGV[0];
my #arr = split(/\s+/,$str);
my $ap = new Algorithm::Permute(\#arr);
while (my #res = $ap->next()) { print("#res\n"); }
' 'how are you';
## you are how
## are you how
## are how you
## you how are
## how you are
## how are you
You can use List::Permutor CPAN module:
use strict;
use warnings;
use List::Permutor;
my $perm = new List::Permutor qw/ how are you /;
while (my #set = $perm->next)
{
print "#set\n";
}
Output:
how are you
how you are
are how you
are you how
you how are
you are how
As bgoldst suggested Algorithm::Permute, for faster execution you can write this without using while loop:
use Algorithm::Permute;
my #array = qw(how are you);
Algorithm::Permute::permute {
print "#array\n";
}#array;

Why does Test::MockObject make thawing my objects throw warnings?

This one needs a bit of explanation to start with. I've got a unit test where I save Class::Std::Fast::Storable objects that come from SOAP::WSDL using Storable. The object I am storing is the result of a webservice call. It ends up being encoded with MIME::Base64 and written somewhere to a file. This is working great.
When I was building up the unit test, I needed to use Test::MockObject to mock the call that webservice, thus returning the restored object. But somehow this is throwing a bunch of warnings about the use of uninitialized value in hash element.
I tried recreating it as a small example. This first bit of code is how I get the base64 output for the example. We will use it in a minute.
use strict;
use warnings;
use MIME::Base64;
use Storable;
use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType;
my $object = SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType->new;
$object->set_value('foo');
print encode_base64(Storable::freeze($object));
So we got three lines of base64. Let's try to restore them:
use strict;
use warnings;
use MIME::Base64;
use Storable;
use Test::Simple tests => 1;
local $/ = undef;
my $object = Storable::thaw(decode_base64(<DATA>));
ok( $object->get_value, 'foo' );
__DATA__
BAgIMTIzNDU2NzgECAgIE0ADAQAAAAQDAQAAAAoDZm9vBQAAAHZhbHVlMAAAAFNPQVA6OldTREw6
OlhTRDo6VHlwZWxpYjo6QnVpbHRpbjo6YW55U2ltcGxlVHlwZYAwU09BUDo6V1NETDo6WFNEOjpU
eXBlbGliOjpCdWlsdGluOjphbnlTaW1wbGVUeXBlEAQICDEyMzQ1Njc4BAgICAUBAAAAAQ==
Neat. It works!
~> perl foo.t
1..1
ok 1 - foo
Now let's add Test::MockObject.
use strict;
use warnings;
use MIME::Base64;
use Storable;
use Test::Simple tests => 1;
use Test::MockObject; # <------- only line I changed
local $/ = undef;
my $object = Storable::thaw(decode_base64(<DATA>));
ok( $object->get_value, 'foo' );
__DATA__
BAgIMTIzNDU2NzgECAgIE0ADAQAAAAQDAQAAAAoDZm9vBQAAAHZhbHVlMAAAAFNPQVA6OldTREw6
OlhTRDo6VHlwZWxpYjo6QnVpbHRpbjo6YW55U2ltcGxlVHlwZYAwU09BUDo6V1NETDo6WFNEOjpU
eXBlbGliOjpCdWlsdGluOjphbnlTaW1wbGVUeXBlEAQICDEyMzQ1Njc4BAgICAUBAAAAAQ==
Ok, this is weird. It works, but it throws an error.
1..1
Use of uninitialized value in hash element at /usr/lib/perl5/site_perl/5.16.2/SOAP/WSDL/XSD/Typelib/Builtin/anySimpleType.pm line 53, <DATA> chunk 1.
ok 1 - foo
So I looked at line 53 of anySimpleType.pm, and it says:
my $OBJECT_CACHE_REF = Class::Std::Fast::OBJECT_CACHE_REF();
sub new {
my $self = pop #{ $OBJECT_CACHE_REF->{ $_[0] } }; # <-- here
$self = bless \(my $o = Class::Std::Fast::ID()), $_[0]
if not defined $self;
Hmm. $_[0] is undef. Looks like new was called without an argument.
But how the hell can loading Test::MockObject do that? Or maybe that warning is always popping up, but somehow it was not shown before? I debugged it a little, and it turns out the warning is always showing in Komodo IDEs debugger, regardless of what I loaded.
However, it only shows up in the normal program output if I have Test::MockObject loaded as well. Can anyone explain that to me?
I still don't know why this is happening exactly. My debugging led me to believe that the initialization warnings are always thrown by these Storable objects. However, they are silent if Test::MockObject is not there.
So the workaround to get it to shut up is as follows:
local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /uninitialized/};
local $/ = undef;
my $object = Storable::thaw(decode_base64(<DATA>));
ok( $object->get_value, 'foo' );

Importing a .pl file

I was wondering how to import a Perl file to a script. I experimented with use, require and do, but nothing seems to work for me. This is how I did it with require:
#!/usr/bin/perl
require {
(equations)
}
print "$x1\n";
Is it possible to code for substituting a value (I get in my script) into equations.pl, then have my script use an equation defined in equations.pl to calculate another value? How do I do this?
You can require a .pl file, which will then execute the code in it, but in order to access variables, you need a package, and either "use" instead of require (the easy way) or via Exporter.
http://perldoc.perl.org/perlmod.html
Simple example: here's the stuff you want to import, name it Example.pm:
package Example;
our $X = 666;
1; # packages need to return true.
And here's how to use it:
#!/usr/bin/perl -w
use strict;
use Example;
print $Example::X;
This presumes Example.pm is in the same directory, or the top level of an #INC directory.
equations.pm file:
package equations;
sub add_numbers {
my #num = #_;
my $total = 0;
$total += $_ for #num;
$total;
}
1;
test.pl file:
#!/usr/bin/perl -w
use strict;
use equations;
print equations::add_numbers(1, 2), "\n";
output:
3
You can't import a file. You can execute a file and import symbols (variables and subs) from it. See Perl Modules in perlmod.
You've given very few details about equations.pl, but if the input can be given via a command line argument, then you can open a pipe:
use strict;
use warnings;
my $variable; #the variable that you will get from equations.pl
my $input=5; #the input into equations.pl
open (my $fh,"-|","perl equations.pl $input") or die $!;
while(my $output=<$fh>)
{
chomp($output); #remove trailing newline
$variable=$output;
}
if(defined($variable))
{
print "It worked! \$variable=$variable\n";
}
else
{
print "Nope, \$variable is still undefined...\n";
}
If this is the body of equations.pl:
use strict;
use warnings;
my $foo=$ARGV[0];
$foo++;
print "$foo\n";
Then the code above outputs:
It worked! $variable=6

How to find files/folders recursively in Perl script?

I have a perl script which I have written to search files present in my windows folders, recursively. I enter the search text as the perl script runtime argument to find a file having this text in it's name. The perl script is as below:
use Cwd;
$file1 = #ARGV[0];
##res1 = glob "*test*";
##res1 = glob "$file1*";
#res1 = map { Cwd::abs_path($_) } glob "$file1*";
foreach (#res1)
{
print "$_\n";
}
But this is not searching all the sub-directories recursively. I know glob doesn't match recursively.
So tried using module File::Find and the function find(\&wanted, #directories);
But I got a error saying find() undefined. From what I read from help, I thought find() function is defined by default in Perl installation, with some basic code to find folders/files. Isn't it correct?
Questions is, in the above perl script, how do I search for files/folders recursively?
Second questions, I found that perldoc <module> help does not have examples about using a certain function in that module, which would make it clear.
Can you point to some good help/document/book for using various perl functions from different perl modules with clear examples of usage of those module functions.
Another excellent module to use is File::Find::Rule which hides some of the complexity of File::Find while exposing the same rich functionality.
use File::Find::Rule;
use Cwd;
my $cwd = getcwd();
my $filelist;
sub buildFileIndex {
open ($filelist, ">", "filelist.txt") || die $!;
# File find rule
my $excludeDirs = File::Find::Rule->directory
->name('demo', 'test', 'sample', '3rdParty') # Provide specific list of directories to *not* scan
->prune # don't go into it
->discard; # don't report it
my $includeFiles = File::Find::Rule->file
->name('*.txt', '*.csv'); # search by file extensions
my #files = File::Find::Rule->or( $excludeDirs, $includeFiles )
->in($cwd);
print $filelist map { "$_\n" } #files;
return \$filelist;
}
These two pages are all you need to study:
File::Find documentation
Beginners guide to File::Find
If you don't mind using cpan module, Path::Class can do the work for you:
use Path::Class;
my #files;
dir('.')->recurse(callback => sub {
my $file = shift;
if($file =~ /some text/) {
push #files, $file->absolute->stringify;
}
});
for my $file (#files) {
# ...
}
An alternative would be to use find2perl to create the start of the script for you. It can turn a find command like,
find . -type f -name "*test*" -print
To an equivalent perl script. You just put find2perl instead of find. It uses File::Find under the hood but gets you going quickly.
use 5.010; # Enable 'say' feature
use strict;
use warnings;
use File::Find; # The module for 'find'
find(\&wanted, #ARGV); # #ARGV is the array of directories to find.
sub wanted {
# Do something...
# Some useful variables:
say $_; # File name in each directory
say $File::Find::dir; # the current directory name
say $File::Find::name; # the complete pathname to the file
}
Example for listing driver modules on Linux (Fedora):
use 5.022;
use strict;
use warnings;
use POSIX qw(uname);
use File::Find;
my $kernel_ver = (uname())[2];
my #dir = (
"/lib/modules/$kernel_ver/kernel/drivers"
);
find(\&wanted, #dir);
sub wanted {
say if /.*\.ko\.xz/;
}

How can I create a Perl variable name based on a string?

In Perl, is it possible to create a global variable based on a string?
E.g., if I had a function like:
sub create_glob_var {
my ($glob_var_str) = #_;
# something like this ( but not a hash access).
our ${$glob_var_str};
};
and I called it like:
create_glob_var( "bar" );
How could I modify create_glob_var to actually create a global variable called $bar?
My project is using perl 5.8.5.
EDIT
The following doesn't work:
use strict;
BEGIN {
sub create_glob_var {
my ($glob_var_str) = #_;
no strict 'refs';
$$glob_var_str = undef; # or whatever you want to set it to
}
create_glob_var("bah");
};
$bah = "blah";
Produces:
Variable "$bah" is not imported at /nfs/pdx/home/rbroger1/tmp2.pl line 12.
Global symbol "$bah" requires explicit package name at /nfs/pdx/home/rbroger1/tmp2.pl line 12.
Execution of /nfs/pdx/home/rbroger1/tmp2.pl aborted due to compilation errors.
NOTE I realize that using global variables causes ozone depletion and male pattern baldness. I'm trying to clean up some legacy code that is already completely infected with the use of global variables. One refactor at a time...
If you are trying to clean up old code, you can write a module which exports the required variable(s). Every time you feel the need to invoke create_glob_var, instead add a variable to this package and put that in the import list.
This will help you keep track of what is going on and how variables are being used.
package MyVars;
use strict; use warnings;
use Exporter 'import';
our($x, %y, #z);
our #EXPORT_OK = qw( $x %y #z );
The script:
#!/usr/bin/perl
use strict;use warnings;
use MyVars qw( $x %y #z );
$x = 'test';
%y = (a => 1, b => 2);
#z = qw( a b c);
use Data::Dumper;
print Dumper \($x, %y, #z);
Output:
$VAR1 = \'test';
$VAR2 = {
'a' => 1,
'b' => 2
};
$VAR3 = [
'a',
'b',
'c'
];
sub create_glob_var {
my ($glob_var_str) = #_;
no strict 'refs';
$$glob_var_str = undef; # or whatever you want to set it to
}
The no strict 'refs' is only necessary if use strict is in effect, which it always should be.
Addendum:
If you're asking if there's a way to write a subroutine create_glob_var such that the following code will succeed:
use strict;
create_glob_var("bar");
$bar = "whatever";
...then the answer is "No." However, Perl's vars pragma will do what you want:
use strict;
use vars qw($bar);
$bar = "whatever";
But this is kind of old-style Perl coding. Nowadays, one would typically do this:
use strict;
our $bar = "blah";
our can also just declare global variables that can be freely used later:
our ($foo, #bar, %baz);
# ...
$foo = 5;
#bar = (1, 2, 3);
%baz = (this => 'that');
Try looking at this question:
Does Perl have PHP-like dynamic variables?
In brief, it seems like you should be able to do $$glob_var_str = "whatever";
You would have to use an eval, but that's generally considered evil. Something like:
eval("$glob_var_str = \#_;");
EDIT
Just verified that you can only do this without the my and with no strict refs.
The vars pragma already does the heavy lifting for what you want, so put it to work:
#! /usr/bin/perl
use warnings;
use strict;
use vars;
BEGIN { vars->import(qw/ $bah /) }
$bah = "blah";
print $bah, "\n";
If you prefer to spell it create_glob_var, then use
#! /usr/bin/perl
use warnings;
use strict;
use vars;
sub create_glob_var { vars->import("\$$_[0]") }
BEGIN { create_glob_var "bah" }
$bah = "blah";
print $bah, "\n";
Either way, the output is
blah
I'm curious to know why you want to do it this way rather than declaring these variables with our. Yes, it may take a few iterations to catch them all, but these are short-term fixes anyway, right?
In general, you can use a variable as a variable name (see "Symbolic references" in perlref), but you really, really, really don't want to do that: enabling the strict 'refs' pragma disables this feature.
Rafael Garcia-Suarez showed great wisdom when he wrote, “I don't know what your original problem is, but I suggest to use a hash.”
See also:
Why it's stupid to 'use a variable as a variable name'
A More Direct Explanation of the Problem
What if I'm really careful?
Answer by Sinan Ünür is indeed the best. However, this picked my curiosity, so I did a bit of reading (perldoc perlmod)and learned about "package_name::" hash as a way to access the namespace of a package.
The following code adds a record to symbol table of main:: package:
use strict;
my $name = "blah";
my $var = "sss";
$main::{$name} = \$var;
print "$main::blah\n";
This prints "sss".
However, I had to add package name to print statement because "use strict" is still not fooled. I'll keep looking - use vars does not seem to work at the moment.