How to create own module for reuse in Perl? - perl

I wish to create my own module and I want to use that module name for further use. The main concept is: Create a module which should contain subroutines for line count, word-count and character count, and in main program I should use that module and I should read the file and the output should show me total number of lines, total number of words and total number of characters in that file.
package Countsample;
use strict;
use base"Exporter";
use 5.010;
our #EXPORT=qw/line_count/;
sub line_count
{my $line=#_;
return $line;
}
1;
This above doc is saved in Count.pm.
#!usr/bin/perl
use Countsample;
open FH,"text1.txt";
line_count();
print"$line\n";
The above code is saved in Count1.pl format.
I think this much information is enough to create, if you need any further information then let me know.
Kindly help me to create complete this task.

Let's start with the module. It was already mentioned, that it is common practice to name the file as the package it contains.
And there is a reason for this: using use with a name builds on the expectation that there will be a file somewhere in the path list (#INC) for modules by that name containing a matching namespace declaration (package whatever). This connection makes possible, what Exporter does in the first place.
http://perldoc.perl.org/Exporter.html
A more indepth but still succinct explanation of this can be found here
http://www.perlmonks.org/?node_id=102347
So the file would be named Countsample.pm:
package Countsample;
use strict;
use warnings;
use base "Exporter";
use 5.010;
our #EXPORT=qw/line_count/;
sub line_count
{
my ($fd) = (#_);
my $lines = 0;
while (<$fd>) {
$lines++
}
return $lines;
}
1;
I added use strict and use warnings to be notified about errors.
Then I changed the assignment of the arguments; the arguments in #_ are a list, so I assign those to a list on the left side (see the parentheses around $fd). You could use
my $fd = shift;
alternatively.
I chose to pass an open filehandle as an argument here, then count the lines, simply by reading the file linewise and returning the number of lines.
There are many ways to get the number of lines out of a file, just as a reference:
http://www.perlmonks.org/?node_id=538824
The main program then looks like this:
#!/usr/bin/perl
use v5.14;
use strict;
use warnings;
use Countsample;
open (my $fd, "<", "text1.txt");
say line_count($fd);
close($fd);
See http://perldoc.perl.org/functions/open.html for the ways to open a file that are available and preferable.

You really need to work on your question asking. You're not giving us enough to go on. You need to tell us:
Exactly what you want to do
Exactly what you have done
Exactly what expected behaviour you are seeing (including any error messages)
Let's step through getting past some of your errors.
Firstly, when I ran your program, I got this.
$ ./Count1.pl
bash: ./Count1.pl: usr/bin/perl: bad interpreter: No such file or directory
Ok, so that's just a stupid typo. But because you haven't explained what problems you are getting, we don't know if that's the problem you're seeing or whether you've introduced the typo when posting your question.
But it's easy to fix. The shebang line needs to be #!/usr/bin/perl. I'm pretty sure you had exactly the same typo in your last question!
Now what happens when I run your code.
$ ./Count1.pl
Can't locate Countsample.pm in #INC (you may need to install the Countsample module) (#INC contains: ...)
This is because your package doesn't have the same name as your module file. Why would you do that? It just complicates your life.
Ok, so let's fix the use statement so it's looking for the right thing - use Count.
Now I get a different error.
$ ./Count1.pl
Undefined subroutine &main::line_count called at ./Count1.pl line 5.
That's going to be a little harder to track down. So to make my life easier I'll turn on use strict and use warnings in both of the files.
I now get this:
$ ./Count1.pl
Global symbol "$line" requires explicit package name at ./Count1.pl line 9.
Execution of ./Count1.pl aborted due to compilation errors.
That means I'll need to declare the variable $line at some point so I'll add my $line just after the use Count line.
And now I get this:
$ ./Count1.pl
Name "main::FH" used only once: possible typo at ./Count1.pl line 8.
Undefined subroutine &main::line_count called at ./Count1.pl line 9.
At which point, I'm afraid, I get bored of digging. Had you presented us with this version of the code, then I might have had some energy left to investigate from here. But because I've spent ten minutes finding silly typos and fixing pointless bugs, I've lost all enthusiasm.
It's important to realise that the people here are all volunteers. We're happy to help you solve your problems, but you need to do some of the work yourself. You need to ensure that we don't waste time fixing obvious things that you could have found yourself. And you need to be a lot clearer than you have been so far when explaining what the problem is.
Here's the version of you code that I got to. Perhaps someone else will have the enthusiasm to take it to the next stage.
Count.pm
package Countsample;
use strict;
use warnings;
use base "Exporter";
use 5.010;
our #EXPORT = qw/line_count/;
sub line_count {
my $line = #_;
return $line;
}
1;
Count1.pl
#!/usr/bin/perl
use strict;
use warnings;
use Count;
my $line;
open FH,"text1.txt";
line_count();
print "$line\n";
Update: The "undefined subroutine" error was because I forgot to change the name of the package in Count.pm. Having done that I now get:
$ ./Count1.pl
Name "main::FH" used only once: possible typo at ./Count1.pl line 8.
Use of uninitialized value $line in concatenation (.) or string at ./Count1.pl line 10.
Which is the point at which you really need to start thinking about how your module works. What subroutines do you need? What parameters do they take? What do they return?

Related

Using filehandles in Perl to alter actively running code

I've been learning about filehandles in Perl, and I was curious to see if there's a way to alter the source code of a program as it's running. For example, I created a script named "dynamic.pl" which contained the following:
use strict;
use warnings;
open(my $append, ">>", "dynamic.pl");
print $append "print \"It works!!\\n\";\n";
This program adds the line
print "It works!!\n";
to the end of it's own source file, and I hoped that once that line was added, it would then execute and output "It works!!"
Well, it does correctly append the line to the source file, but it doesn't execute it then and there.
So I assume therefore that when perl executes a program that it loads it to memory and runs it from there, but my question is, is there a way to access this loaded version of the program so you can have a program that can alter itself as you run it?
The missing piece you need is eval EXPR. This compiles, "evaluates", any string as code.
my $string = q[print "Hello, world!";];
eval $string;
This string can come from any source, including a filehandle.
It also doesn't have to be a single statement. If you want to modify how a program runs, you can replace its subroutines.
use strict;
use warnings;
use v5.10;
sub speak { return "Woof!"; }
say speak();
eval q[sub speak { return "Meow!"; }];
say speak();
You'll get a Subroutine speak redefined warning from that. It can be supressed with no warnings "redefine".
{
# The block is so this "no warnings" only affects
# the eval and not the entire program.
no warnings "redefine";
eval q[sub speak { return "Shazoo!"; }];
}
say speak();
Obviously this is a major security hole. There is many, many, many things to consider here, too long for an answer, and I strongly recommend you not do this and find a better solution to whatever problem you're trying to solve this way.
One way to mitigate the potential for damage is to use the Safe module. This is like eval but limits what built in functions are available. It is by no means a panacea for the security issues.
With a warning about all kinds of issues, you can reload modules.
There are packages for that, for example, Module::Reload. Then you can write code that you intend to change in a module, change the source at runtime, and have it reloaded.
By hand you would delete that from %INC and then require, like
# ... change source code in the module ...
delete $INC{'ModuleWithCodeThatChages.pm'};
require ModuleWithCodeThatChanges;
The only reason I can think of for doing this is experimentation and play. Otherwise, there are all kinds of concerns with doing something like this, and whatever your goal may be there are other ways to accomplish it.
Note The question does specify a filehandle. However, I don't see that to be really related to what I see to be the heart of the question, of modifying code at runtime.
The source file isn't used after it's been compiled.
You could just eval it.
use strict;
use warnings;
my $code = <<'__EOS__'
print "It works!!\n";
__EOS__
open(my $append_fh, ">>", "dynamic.pl")
or die($!);
print($append_fh $code);
eval("$code; 1")
or die($#);
There's almost definitely a better way to achieve your end goal here. BUT, you could recursively make exec() or system() calls -- latter if you need a return value. Be sure to setup some condition or the dominoes will keep falling. Again, you should rethink this, unless it's just practice of some sort, or maybe I don't get it!
Each call should execute the latest state of the file; also be sure to close the file before each call.
i.e.,
exec("dynamic.pl"); or
my retval;
retval = system("perl dynamic.pl");
Don't use eval ever.

Is it possible to delay loading BerkeleyDB?

As suggested in a previous question, one way to delay loading modules would be to use require. I would like to delay loading BerkeleyDB until it is necessary, instead of loading it every time my application runs. It would also be nice to test if BerkeleyDB is available. Here is my attempt, which seems to work with every other module I tried (calling the script 'load_bdb.pl'):
#!/usr/bin/env perl
use 5.010;
use strict;
use warnings;
my %hash;
eval {
require BerkeleyDB;
BerkeleyDB->import();
1;
} or do {
my $error = $#;
die "\nERROR: Couldn't load BerkeleyDB" if $error;
};
tie %hash, 'BerkeleyDB::Btree', -Filename => 'db_file', -Flags => DB_CREATE
or die "\nERROR: Could not open DBM file: db_file: $! $BerkeleyDB::Error\n";
This generates the following error:
Bareword "DB_CREATE" not allowed while "strict subs" in use at load_bdb.pl line 18.
Execution of load_bdb.pl aborted due to compilation errors.
Suppressing the errors does not solve the problem because I then get:
Name "BerkeleyDB::Error" used only once: possible typo at load_bdb.pl line 20.
ERROR: Could not open DBM file: db_file: No such file or directory
This suggests to me that the require and import statements above are not importing BerkeleyDB correctly, whereas this works fine with use. So, why does require not work with this particular module and is there another solution?
When you run a perl script the execution goes through several phases. One of the first is compilation. During compilation it tries to resolve words such as DB_CREATE to decide what they are. In the case where BerkelyDB has not been loaded in advance (by use) then the first time it is encountered in the tie statement, perl does not know what it is.
In this case it is actually a constant sub which will be later defined and imported, when you require BerkelyDB. Note that use is a compile time operation, while require normally occurs at run time. To avoid the error you can put a & in front of the name so perl knows it is actually a sub (eg. &DB_CREATE)
The other warning if similar. You are reading a variable which would normally belong to the BerkeleyDB package, but since you did not load it, the variable is not referenced anywhere except in the one place. That leads perl to think it might be a typo in your script.
You could resolve that by setting it to something (eg. Undef) at the top of the script.

Finding files writable by everyone using perl

I'm writing a Perl script which will scan the filesystem for files that are writable by everyone. I've looked at a couple items that have helped me. Primarily this Stonehenge.com post from 2001 and a question previously asked here. Both have directed me to most of a solution. I am able to now find files that are writable by everyone, however, I have some concerns.
For starters, my script:
#!/usr/bin/perl
use warnings;
use strict;
use File::Find;
use Sys::Hostname;
my $hostname = hostname;
my $file = "/tmp/$hostname" . "_ww_files.txt";
open (WWFILE, ">>$file");
find sub {
return unless (stat)[2] & 00002; # ...and world writeable
return if "$File::Find::name" =~ m/(\/tmp)|(^\/dev)/;
print "$File::Find::name\n";
}, "/";
My first concern is that when I run the script it frequently throws an error on several files that states Use of uninitialized value in bitwise and (&) at ./ww_files.pl line 15.. This, of course, being the line that checks the mode of the file and then does a bitwise AND in order to find only those that have a "w" in the second column of each octet. Or so I'd like to believe, but I'm quite certain I'm not really looking for the right permissions with that method.
To be clear on this, all I care about is the "w". I don't care if a file is readable by everyone or even executable by everyone. So I suppose my second concern by way of the question I should be asking is what should that AND mask be in order to ignore everything but the "w"?
From the File::Find docs "if you use the warnings pragma, File::Find will report warnings for several weird situations." I wouldn't worry too much about them. To be sure about the mask you could use the constant S_IWOTH from Fcntl:
use Fcntl ':mode';
use File::Find;
no warnings 'File::Find';
find sub {
return unless (stat)[2] & S_IWOTH; # ...and world writeable
Probably the file could not be stated and so the value is undefined. You can easily trap that, though;
my #s = stat();
unless (#s) {
warn "$File::Find::name: stat failed: $!\n";
return;
}
return unless $s[2] & 0x02;
Generally speaking, you should check the return value of system calls for errors.
The mask value of 2 is precisely correct for finding world-writable files. However, perhaps you also want to check for odd group-writable files where the group is something weird?

Is there a tool to check a Perl script for unnecessary use statements?

For Python, there is a script called importchecker which tells you if you have unnecessary import statements.
Is there a similar utility for Perl use (and require) statements?
Take a look at Devel::TraceUse it might give you a chunk of what you're looking for.
Here is a script I wrote to attempt this. It is very simplistic and will not automate anything for you but it will give you something to start with.
#!/usr/bin/perl
use strict;
use v5.14;
use PPI::Document;
use PPI::Dumper;
use PPI::Find;
use Data::Dumper;
my %import;
my $doc = PPI::Document->new($ARGV[0]);
my $use = $doc->find( sub { $_[1]->isa('PPI::Statement::Include') } );
foreach my $u (#$use) {
my $node = $u->find_first('PPI::Token::QuoteLike::Words');
next unless $node;
$import{$u->module} //= [];
push $import{$u->module}, $node->literal;
}
my $words = $doc->find( sub { $_[1]->isa('PPI::Token::Word') } );
my #words = map { $_->content } #$words;
my %words;
#words{ #words } = 1;
foreach my $u (keys %import) {
say $u;
foreach my $w (#{$import{$u}}) {
if (exists $words{$w}) {
say "\t- Found $w";
}
else {
say "\t- Can't find $w";
}
}
}
There is a number of ways to load packages and import symbols (or not). I am not aware of a tool which single-handedly and directly checks whether those symbols are used or not.
But for cases where an explicit import list is given,
use Module qw(func1 func2 ...);
there is a Perl::Critic policy TooMuchCode::ProhibitUnusedImport that helps with much of that.
One runs on the command line
perlcritic --single-policy TooMuchCode::ProhibitUnusedImport program.pl
and the program is checked. Or run without --single-policy flag for a complete check and seek Severity 1 violations in the output, which this is.
For an example, consider a program
use warnings;
use strict;
use feature 'say';
use Path::Tiny; # a class; but it imports 'path'
use Data::Dumper; # imports 'Dumper'
use Data::Dump qw(dd pp); # imports 'dd' and 'pp'
use Cwd qw(cwd); # imports only 'cwd'
use Carp qw(carp verbose); # imports 'carp'; 'verbose' isn't a symbol
use Term::ANSIColor qw(:constants); # imports a lot of symbols
sub a_func {
say "\tSome data: ", pp [ 2..5 ];
carp "\tA warning";
}
say "Current working directory: ", cwd;
a_func();
Running the above perlcritic command prints
Unused import: dd at line 7, column 5. A token is imported but not used in the same code. (Severity: 1)
Unused import: verbose at line 9, column 5. A token is imported but not used in the same code. (Severity: 1)
We got dd caught, while pp from the same package isn't flagged since it's used (in the sub), and neither are carp and cwd which are also used; as it should be, out of what the policy aims for.
But note
whatever comes with :constants tag isn't found
word verbose, which isn't a function (and is used implicitly), is reported as unused
if a_func() isn't called then those pp and carp in it are still not reported even though they are then unused. This may be OK, since they are present in code, but it is worth noting
(This glitch-list is likely not exhaustive.)
Recall that the import list is passed to an import sub, which may expect and make use of whatever the module's design deemed worthy; these need not be only function names. It is apparently beyond this policy to follow up on all that. Still, loading modules with the explicit import list with function names is good practice and what this policy does cover is an important use case.
Also, per the clearly stated policy's usage, the Dumper (imported by Data::Dumper) isn't found, nor is path from Path::Tiny. The policy does deal with some curious Moose tricks.
How does one do more? One useful tool is Devel::Symdump, which harvests the symbol tables. It catches all symbols in the above program that have been imported (no Path::Tiny methods can be seen if used, of course). The non-existing "symbol" verbose is included as well though. Add
use Devel::Symdump;
my $syms = Devel::Symdump->new;
say for $syms->functions;
to the above example. To also deal with (runtime) require-ed libraries we have to do this at a place in code after they have been loaded, what can be anywhere in the program. Then best do it in an END block, like
END {
my $ds = Devel::Symdump->new;
say for $ds->functions;
};
Then we need to check which of these are unused. At this time the best tool I'm aware of for that job is PPI; see a complete example. Another option is to use a profiler, like Devel::NYTProf.
Another option, which requires some legwork†, is the compiler's backend B::Xref, which gets practically everything that is used in the program. It is used as
perl -MO=Xref,-oreport_Xref.txt find_unused.pl
and the (voluminous) output is in the file report_Xref.txt.
The output has sections for each involved file, which have subsections for subroutines and their packages. The last section of the output is directly useful for the present purpose.
For the example program used above I get the output file like
File /.../perl5/lib/perl5//Data/Dump.pm
...
(some 3,000 lines)
...
File find_unused.pl --> there we go, this program's file
Subroutine (definitions)
... dozens of lines ...
Subroutine (main)
Package main
&a_func &43
&cwd &27
Subroutine a_func
Package ?
#?? 14
Package main
&carp &15
&pp &14
So we see that cwd gets called (on line 27) and that carp and pp are also called in the sub a_func. Thus dd and path are unused (out of all imported symbols found otherwise, by Devel::Symdump for example). This is easy to parse.
However, while path is reported when used, if one uses new instead (also in Path::Tiny as a traditional constructor) then that isn't reported in this last section, nor are other methods.
So in principle† this is one way to find which of the symbols (for functions) reported to exist by Devel::Symdump have been used in the program.
† The example here is simple and easy to process but I have no idea how complete, or hard to parse, this is when all kinds of weird ways for using imported subs are taken into account.

How can I get the file and line number where a Perl subroutine reference was created?

Given a subroutine reference, is there a way to find out the file and line number where the subroutine was declared? warn and friends seems to get this right, but I need this externally. Here's my test program:
#!/usr/bin/perl -l
use strict;
use warnings;
use B;
# line 99 'bin/some_code.pl'
{
no strict 'refs';
print B::svref_2object(\*{'Foo::some_sub'})->LINE;
print B::svref_2object(\&Foo::some_sub)->GV->LINE;
}
Foo::some_sub();
package Foo;
# line 23 'bin/some_file.pl'
sub some_sub {
warn "Got to here";
}
That outputs:
102
102
Got to here at 'bin/some_file.pl' line 24.
The line information is not what I'm expecting, so I assume I'm doing something wrong (B::GV has a corresponding FILE method, but until I get LINE working, it's not much use to me).
Is there some other way to get this information and am I doing something wrong in the above code?
Update: As it turns out, the 'FILE' and 'LINE' methods seem to work OK if I'm not using line directives. Looks like it may be a bug in the B::GV module.
You could try looking at caller. This is what the debugger uses to build stack traces, so maybe it is what you want.
I don't think __LINE__, __FILE__ and __PACKAGE__ help you here as they only provide the location of the current point of execution, meaning that given a code reference or sub as in your code you will get the same results.
You're already doing some of this, but also see the Perlmonks thread "Track the filename/line number of an anonymous coderef".