Situation:
I have a module Foo::Quux::Bar, living in ./Bar.pm. I need to be able to unit test Bar. However, it is not advantageous due to circumstances beyond my control to set up a Foo/Quux directory structure.
So what I'd like to do is have some sort of unit_test_use routine that lets me grab Bar.pm and move/copy its functions into the local namespace(Note that Bar has a package Foo::Quux::Bar specifier) for my testing pleasure.
Grubbing around in the Perl documentation has not helped me.
Assuming your Bar.pm exports its functions in the standard way, you can load it with require and do the import manually:
BEGIN {
require 'Bar.pm'; # now the package Foo::Quux::Bar is set up
Foo::Quux::Bar->import;
};
But it's definitely worth looking into setting up the directory structure in the standard way, if you can.
The example below uses the following Bar.pm:
package Foo::Quux::Bar;
use warnings;
use strict;
sub one { 1 }
sub two { "zwei" }
sub three { 0x3333 }
1;
In your test-bar program, you can install a hook that will use the current directory's Bar.pm with
#! /usr/bin/perl
use warnings;
use strict;
use File::Basename;
BEGIN {
sub find_bar {
my(undef,$name) = #_;
if (basename($name) eq "Bar.pm") {
open my $fh, "<", "./Bar.pm" or die "$0: open ./Bar.pm: $!";
$fh;
}
}
unshift #INC => \&find_bar;
}
Hooks in #INC are documented in the perlfunc documentation for require.
Now to import all subs, ignoring any import in Foo::Quux::Bar,
# fake use Foo::Quux::Bar
BEGIN {
require Foo::Quux::Bar;
{
no strict 'refs';
while (my($name,$glob) = each %Foo::Quux::Bar::) {
if (*{ $glob }{CODE}) {
*{ __PACKAGE__ . "::" . $name } = *{ $glob }{CODE};
}
}
}
}
Back out in the test code where the strict pragma is enabled, we can
print map "$_\n", one, two, three;
and get the following output:
1
zwei
13107
Here's what I wrote:
sub import_module_into_main
{
my ($mod_name, $filename) = #_;
require $filename;
no strict;
foreach my $var ( keys( %{$mod_name . "::"}))
{
$main::{$var} = ${$mod_name. "::"}{$var};
}
}
Invoke with this: import_module_into_main("Foo::Quux::Bar", "Bar.pm").
Related
Let's take something very simple,
# Foo.pm
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}
Is there anyway that I can from test.pl run code that changes what $baz is set to and causes Foo.pm to print something else to the screen?
# maybe something here.
use Foo;
# maybe something here
Is it possible with the compiler phases to force the above to print 7?
A hack is required because require (and thus use) both compiles and executes the module before returning.
Same goes for eval. eval can't be used to compile code without also executing it.
The least intrusive solution I've found would be to override DB::postponed. This is called before evaluating a compiled required file. Unfortunately, it's only called when debugging (perl -d).
Another solution would be to read the file, modify it and evaluate the modified file, kinda like the following does:
use File::Slurper qw( read_binary );
eval(read_binary("Foo.pm") . <<'__EOS__') or die $#;
package Foo {
no warnings qw( redefine );
sub bar { 7 }
}
__EOS__
The above doesn't properly set %INC, it messes up the file name used by warnings and such, it doesn't call DB::postponed, etc. The following is a more robust solution:
use IO::Unread qw( unread );
use Path::Class qw( dir );
BEGIN {
my $preamble = '
UNITCHECK {
no warnings qw( redefine );
*Foo::bar = sub { 7 };
}
';
my #libs = #INC;
unshift #INC, sub {
my (undef, $fn) = #_;
return undef if $_[1] ne 'Foo.pm';
for my $qfn (map dir($_)->file($fn), #libs) {
open(my $fh, '<', $qfn)
or do {
next if $!{ENOENT};
die $!;
};
unread $fh, "$preamble\n#line 1 $qfn\n";
return $fh;
}
return undef;
};
}
use Foo;
I used UNITCHECK (which is called after compilation but before execution) because I prepended the override (using unread) rather than reading in the whole file in and appending the new definition. If you want to use that approach, you can get a file handle to return using
open(my $fh_for_perl, '<', \$modified_code);
return $fh_for_perl;
Kudos to #Grinnz for mentioning #INC hooks.
Since the only options here are going to be deeply hacky, what we really want here is to run code after the subroutine has been added to the %Foo:: stash:
use strict;
use warnings;
# bless a coderef and run it on destruction
package RunOnDestruct {
sub new { my $class = shift; bless shift, $class }
sub DESTROY { my $self = shift; $self->() }
}
use Variable::Magic 0.58 qw(wizard cast dispell);
use Scalar::Util 'weaken';
BEGIN {
my $wiz;
$wiz = wizard(store => sub {
return undef unless $_[2] eq 'bar';
dispell %Foo::, $wiz; # avoid infinite recursion
# Variable::Magic will destroy returned object *after* the store
return RunOnDestruct->new(sub { no warnings 'redefine'; *Foo::bar = sub { 7 } });
});
cast %Foo::, $wiz;
weaken $wiz; # avoid memory leak from self-reference
}
use lib::relative '.';
use Foo;
This will emit some warnings, but prints 7:
sub Foo::bar {}
BEGIN {
$SIG{__WARN__} = sub {
*Foo::bar = sub { 7 };
};
}
First, we define Foo::bar. It's value will be redefined by the declaration in Foo.pm, but the "Subroutine Foo::bar redefined" warning will be triggered, which will call the signal handler that redefines the subroutine again to return 7.
Here is a solution that combines hooking the module loading process with the readonly-making capabilities of the Readonly module:
$ cat Foo.pm
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}
$ cat test.pl
#!/usr/bin/perl
use strict;
use warnings;
use lib qw(.);
use Path::Tiny;
use Readonly;
BEGIN {
my #remap = (
'$Foo::{bar} => \&mybar'
);
my $pre = join ' ', map "Readonly::Scalar $_;", #remap;
my #inc = #INC;
unshift #INC, sub {
return undef if $_[1] ne 'Foo.pm';
my ($pm) = grep { $_->is_file && -r } map { path $_, $_[1] } #inc
or return undef;
open my $fh, '<', \($pre. "#line 1 $pm\n". $pm->slurp_raw);
return $fh;
};
}
sub mybar { 5 }
use Foo;
$ ./test.pl
5
I have revised my solution here, so that it no longer relies on Readonly.pm, after learning that I had missed a very simple alternative, based on m-conrad's answer, which I have reworked into the modular approach that I had started here.
Foo.pm (Same as in the opening post)
package Foo {
my $baz = bar();
sub bar { 42 }; ## Overwrite this
print $baz; ## Before this is executed
}
# Note, even though print normally returns true, a final line of 1; is recommended.
OverrideSubs.pm Updated
package OverrideSubs;
use strict;
use warnings;
use Path::Tiny;
use List::Util qw(first);
sub import {
my (undef, %overrides) = #_;
my $default_pkg = caller; # Default namespace when unspecified.
my %remap;
for my $what (keys %overrides) {
( my $with = $overrides{$what} ) =~ s/^([^:]+)$/${default_pkg}::$1/;
my $what_pkg = $what =~ /^(.*)\:\:/ ? $1 : $default_pkg;
my $what_file = ( join '/', split /\:\:/, $what_pkg ). '.pm';
push #{ $remap{$what_file} }, "*$what = *$with";
}
my #inc = grep !ref, #INC; # Filter out any existing hooks; strings only.
unshift #INC, sub {
my $remap = $remap{ $_[1] } or return undef;
my $pre = join ';', #$remap;
my $pm = first { $_->is_file && -r } map { path $_, $_[1] } #inc
or return undef;
# Prepend code to override subroutine(s) and reset line numbering.
open my $fh, '<', \( $pre. ";\n#line 1 $pm\n". $pm->slurp_raw );
return $fh;
};
}
1;
test-run.pl
#!/usr/bin/env perl
use strict;
use warnings;
use lib qw(.); # Needed for newer Perls that typically exclude . from #INC by default.
use OverrideSubs
'Foo::bar' => 'mybar';
sub mybar { 5 } # This can appear before or after 'use OverrideSubs',
# but must appear before 'use Foo'.
use Foo;
Run and output:
$ ./test-run.pl
5
If the sub bar inside Foo.pm has a different prototype than an existing Foo::bar function, Perl won't overwrite it? That seems to be the case, and makes the solution pretty simple:
# test.pl
BEGIN { *Foo::bar = sub () { 7 } }
use Foo;
or kind of the same thing
# test.pl
package Foo { use constant bar => 7 };
use Foo;
Update: no, the reason this works is that Perl won't redefine a "constant" subroutine (with prototype ()), so this is only a viable solution if your mock function is constant.
Lets have a Golf contest!
sub _override { 7 }
BEGIN {
my ($pm)= grep -f, map "$_/Foo.pm", #INC or die "Foo.pm not found";
open my $fh, "<", $pm or die;
local $/= undef;
eval "*Foo::bar= *main::_override;\n#line 1 $pm\n".<$fh> or die $#;
$INC{'Foo.pm'}= $pm;
}
use Foo;
This just prefixes the module's code with a replacement of the method, which will be the first line of code that runs after the compilation phase and before the execution phase.
Then, fill in the %INC entry so that future loads of use Foo don't pull in the original.
I'm writing a tool that must import a number of other perl config files. The files are not wrapped w/packages and may have similar or conflicting variables/functions. I don't have the ability to change the format of these files, so I must work around what they are. What I was thinking to do was import each into a unique name space, but I've not found a way to do that using do, require, or use. If I don't use dynamic names, just a hardcoded name, I can do it.
Want something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
package $namespace;
do $file;
1;
return;
}
That doesn't work because the package command requires a constant for the name. So then I try something like this:
sub sourceTheFile {
my ($namespace, $file) = #_;
eval "package $namespace;do $file;1;"
return;
}
But the contents of the file read by do are placed in the main:: scope not the one I want. The target scope is created, just not populated by the
do. (I tried require, and just a straight cat $file inside the eval as well.)
I'm using Devel::Symdump to verify that the namespaces are built correctly or not.
example input file:
my $xyz = "some var";
%all_have_this = ( common=>"stuff" );
ADDITIONAL CHALLENGE
Using the answer that does the temp file build and do call, I can make this work dynamically as I require. BUT, big but, how do I now reference the data inside this new namespace? Perl doesn't seem to have the lose ability to build a variable name from a string and use that as the variable.
I am not sure why the eval did not work. Maybe a bug? Here is a workaround using a temp file. This works for me:
use strict;
use warnings;
use Devel::Symdump;
use File::Temp;
my $file = './test.pl';
my $namespace = 'TEST';
{
my $fh = File::Temp->new();
print $fh "package $namespace;\n";
print $fh "do '$file';\n";
print $fh "1;\n";
close $fh;
do $fh->filename;
}
Perl's use and require facilities make use of any hooks you might have installed in #INC. You can simply install a hook which looks in a specific location to load modules with a prefix you choose:
package MyIncHook;
use strict;
use warnings;
use autouse Carp => qw( croak );
use File::Spec::Functions qw( catfile );
sub import {
my ($class, $prefix, $location) = #_;
unshift #INC, _loader_for($prefix, $location);
return;
}
sub _loader_for {
my $prefix = shift;
my $location = shift;
$prefix =~ s{::}{/}g;
return sub {
my $self = shift;
my $wanted = shift;
return unless $wanted =~ /^\Q$prefix/;
my $path = catfile($location, $wanted);
my ($is_done);
open my $fh, '<', $path
or croak "Failed to open '$path' for reading: $!";
my $loader = sub {
if ($is_done) {
close $fh
or croak "Failed to close '$path': $!";
return 0;
}
if (defined (my $line = <$fh>)) {
$_ = $line;
return 1;
}
else {
$_ = "1\n";
$is_done = 1;
return 1;
}
};
(my $package = $wanted) =~ s{/}{::}g;
$package =~ s/[.]pm\z//;
my #ret = (\"package $package;", $loader);
return #ret;
}
}
__PACKAGE__;
__END__
Obviously, modify the construction of $path according to your requirements.
You can use it like this:
#!/usr/bin/env perl
use strict;
use warnings;
use MyIncHook ('My::Namespace', "$ENV{TEMP}/1");
use My::Namespace::Rand;
print $My::Namespace::Rand::settings{WARNING_LEVEL}, "\n";
where $ENV{TEMP}/1/My/Namespace/Rand.pm contains:
%settings = (
WARNING_LEVEL => 'critical',
);
Output:
C:\Temp> perl t.pl
critical
You can, obviously, define your own mapping from made up module names to file names.
I am using more modules in my perl program.
example:
use File::copy;
so likewise File module contains Basename, Path, stat and etc..
i want to list all the subroutine(function) names which is in File Package module.
In python has dir(modulename)
It list all the function that used in that module....
example:
#!/usr/bin/python
# Import built-in module math
import math
content = dir(math)
print content
Like python tell any code for in perl
If you want to look at the contents of a namespace in perl, you can use %modulename::.
For main that's either %main:: or %::.
E.g.:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
sub fish {};
sub carrot {};
print "Stuff defined in Dumper:\n";
print Dumper \%Data::Dumper::;
print "Stuff defined:\n";
print Dumper \%::;
That covers a load of stuff though - including pragmas. But you can check for e.g. subroutines by simply testing it for being a code reference.
foreach my $thing ( keys %:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
And with reference to the above sample, this prints:
sub Dumper
sub carrot
sub fish
So with reference to your original question:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use File::Copy;
print "File::Copy has subs of:\n";
foreach my $thing ( keys %File::Copy:: ) {
if ( defined &$thing ) {
print "sub $thing\n";
}
}
Unfortunately you can't do the same thing with the whole File:: namespace, because there's a whole bunch of different modules that could be installed/loaded, but might not be.
You'd have to use e.g. CPAN to check that -
perl -MCPAN -e shell
i /^File::/
Which will list you around 717 modules that are grouped into the File:: tree.
You could look this up on CPAN. Or if you're just after the core modules, then some variant of using Module::CoreList might do what you want.
Something like this:
#!/usr/bin/perl
use strict;
use warnings;
use Module::CoreList;
foreach my $module ( Module::CoreList->find_modules(qr/^File::/) ) {
if ( eval { require $module =~ s|::|/|gr . ".pm" } ) {
print "Module: $module contains\n";
my $key_str = "\%$module\:\:";
my %stuff = eval $key_str;
foreach my $thing ( sort keys %stuff ) {
my $full_sub_path = "$module::$thing";
if ( eval {"defined &$full_sub_path"} ) {
if ( defined &$thing ) {
print "$thing <- $full_sub_path imported by default\n";
}
else {
print "\t$full_sub_path might be loadable\n";
}
}
}
}
else {
print "Module: $module couldn't be loaded\n";
}
}
It's a bit messy because you have to eval various bits of it to test if a module is in fact present and loadable at runtime. Oddly enough, File::Spec::VMS wasn't present on my Win32 system. Can't think why.... :).
Should note - just because you could import a sub from a module (that isn't exported by default) doesn't make it a good idea. By convention, any sub prefixed with an _ is not supposed to be used externally, etc.
My Devel::Examine::Subs module can do this, plus much more. Note that whether it's a method or function is irrelevant, it'll catch both. It works purely on subroutines as found with PPI.
use warnings;
use strict;
use Devel::Examine::Subs;
my $des = Devel::Examine::Subs->new;
my $subs = $des->module(module => 'File::Copy');
for (#$subs){
print "$_\n";
}
Output:
_move
move
syscopy
carp
mv
_eq
_catname
cp
copy
croak
Or a file/full directory. For all Perl files in a directory (recursively), just pass the dir to file param without a file at the end of the path:
my $des = Devel::Examine::Subs->new(file => '/path/to/file.pm');
my $subs = $des->all;
If you just want to print it use the Data::Dumper module and the following method, CGI used as an example:
use strict;
use warnings;
use CGI;
use Data::Dumper;
my $object = CGI->new();
{
no strict 'refs';
print "Instance METHOD IS " . Dumper( \%{ref ($object)."::" }) ;
}
Also note, it's File::Copy, not File::copy.
i have writed some script, that recursively print's directory's content. But it prints warning for each folder. How to fix this?
sample folder:
dev# cd /tmp/testdev# ls -p -Rtest2/testfiletestfile2
./test2:testfile3testfile4
my code:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp/test');
sub browseDir {
my $path = shift;
opendir(my $dir, $path);
while (readdir($dir)) {
next if /^\.{1,2}$/;
if (-d "$path/$_") {
browseDir("$path/$_");
}
print "$path/$_\n";
}
closedir($dir);
}
and the output:
dev# perl /tmp/cotest.pl/tmp/test/test2/testfile3
/tmp/test/test2/testfile4Use of uninitialized value $_ in
concatenation (.) or string at /tmp/cotest.pl line 16./tmp/test/
/tmp/test/testfile/tmp/test/testfile2
May you try that code:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp');
sub browseDir {
my $path = shift;
opendir(my $dir, $path);
while (readdir($dir)) {
next if /^\.{1,2}$/;
print "$path/$_\n";
if (-d "$path/$_") {
browseDir("$path/$_");
}
}
closedir($dir);
}
If you got that error, its because you call browseDir() before use variable $_.
Why not use the File::Find module? It's included in almost all distributions of Perl since Perl 5.x. It's not my favorite module due to the sort of messy way it works, but it does a good job.
You define a wanted subroutine that does what you want and filter out what you don't want. In this case, you're printing pretty much everything, so all wanted does is print out what is found.
In File::Find, the name of the file is kept in $File::Find::name and the directory for that file is in $File::Find::dir. The $_ is the file itself, and can be used for testing.
Here's a basic way of what you want:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
find ( \&wanted, $directory );
sub wanted {
say $File::Find::Name;
}
I prefer to put my wanted function in my find subroutine, so they're together. This is equivalent to the above:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
find (
sub {
say $File::Find::Name
},
$directory,
);
Good programming says not to print in subroutines. Instead, you should use the subroutine to store and return your data. Unfortunately, find doesn't return anything at all. You have to use a global array to capture the list of files, and later print them out:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find (
sub {
push #directory_list, $File::Find::Name
}, $directory );
for my $file (#directory_list) {
say $file;
}
Or, if you prefer a separate wanted subroutine:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find ( \&wanted, $directory );
sub wanted {
push #directory_list, $File::Find::Name;
}
for my $file (#directory_list) {
say $file;
}
The fact that my wanted subroutine depends upon an array that's not local to the subroutine bothers me which is why I prefer embedding the wanted subroutine inside my find call.
One thing you can do is use your subroutine to filter out what you want. Let's say you're only interested in JPG files:
use strict;
use warnings;
use feature qw(say);
use File::Find;
my $directory = `/tmp/test`;
my #directory_list;
find ( \&wanted, $directory );
sub wanted {
next unless /\.jpg$/i; #Skip everything that doesn't have .jpg suffix
push #directory_list, $File::Find::Name;
}
for my $file (#directory_list) {
say $file;
}
Note how the wanted subroutine does a next on any file I don't want before I push it into my #directory_list array. Again, I prefer the embedding:
find (sub {
next unless /\.jpg$/i; #Skip everything that doesn't have .jpg suffix
push #directory_list, $File::Find::Name;
}
I know this isn't exactly what you asked, but I just wanted to let you know about the Find::File module and introduce you to Perl modules (if you didn't already know about them) which can add a lot of functionality to Perl.
You place a value in $_ before calling browseDir and you expect it the value to be present after calling browseDir (a reasonable expectation), but browseDir modifies that variable.
Just add local $_; to browseDir to make sure that any change to it are undone before the sub exits.
Unrelated to your question, here are three other issues:
Not even minimal error checking!
You could run out of directory handles will navigating a deep directory.
You filter out files ".\n" and "..\n".
Fix:
#!/usr/bin/perl
use strict;
use warnings;
browseDir('/tmp/test');
sub browseDir {
my $path = shift;
opendir(my $dh, $path) or die $!;
my #files = readdir($dh);
closedir($dh);
for (#files) {
next if /^\.{1,2}z/;
if (-d "$path/$_") {
browseDir("$path/$_");
}
print "$path/$_\n";
}
}
Finally, why don't use you a module like File::Find::Rule?
use File::Find::Rule qw( );
print "$_\n" for File::Find::Rule->in('/tmp');
Note: Before 5.12, while (readir($dh)) would have to be written while (defined($_ = readdir($dh)))
How do I apply 'use base' in Perl to inherit subs from some base module?
I'm used to C++ inheritance mechanics, and all the sites I googled for this caused more confusion then help. I want to do something like the following:
#! /usr/bin/perl
#The base class to inherit from
use strict;
use warnings;
package 'TestBase';
#-------------------------------
sub tbSub
{
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use base qw(TestBase);
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
mySub(1);
tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}
Perl complains/cannot find tbSub.
The C++ mechnics aren't much different than the Perl mechanics: To use inheritance, you need two classes: the base class and the inheriting class. But you don't have any descendent class.
You are also lacking a constructor. Unlike C++, Perl will not provide a default constructor for you.
Your base class contains a bad syntax error, so I guess you didn't try the code before posting.
Finally, as tsee already observed, you will have to let Perl know whether you want a function call or a method call.
What you really want would look something like this:
my $foo = TestDescendent->new();
$foo->main();
package TestBase;
sub new {
my $class = shift;
return bless {}, $class;
}
sub tbSub
{
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
package TestDescendent;
use base 'TestBase';
sub main {
my $self = shift;
$self->mySub( 1 );
$self->tbSub( 2 );
$self->mySub( 3 );
}
sub mySub
{
my $self = shift;
my $parm = shift;
print "\nTester: $parm\n";
}
1;
You should have a look at using Moose which is a postmodern object system for Perl5. You will probably find it a lot easier to grasp than using standard Perl OO semantics... especially when coming from another OO language.
Here's a Moose version of your question....
package TestBase;
use Moose;
sub tbSub {
my ($self, $parm) = #_;
print "\nTestBase: $parm\n";
}
package TestDescendent;
use Moose;
extends 'TestBase';
sub main {
my $self = shift;
$self->mySub( 1 );
$self->tbSub( 2 );
$self->mySub( 3 );
}
sub mySub {
my ($self, $parm) = #_;
print "\nTester: $parm\n";
}
package main;
my $foo = TestDescendent->new();
$foo->main
The differences are....
Constructor automatically created for you &
Inheritance defined by "extends" command instead of "use base".
So this example only covers the tip of the Moose iceberg ;-)
As a sidenote, there is little good reason to use base rather than the newer use parent.
It seems to me, you are mixing up two things here: Object-Oriented and Procedural Perl. Perl OO is kind of "different" (as in not mainstream but workable).
Your TestBase.pm module seems to expect to be run as a Perl object (Perl oo-style), but your Perl script wants to access it as "normal" module. Perl doesn't work the way C++ does (as you realised) so you would have to construct your code differently. See Damian Conway's books for explanations (and smarter code than mine below).
Procedural:
#! /usr/bin/perl
#The module to inherit from
package TestBase;
use strict;
use warnings;
use Exporter ();
our #ISA = qw (Exporter);
our #EXPORT = qw (tbSub);
#-------------------------------
sub tbSub
{
my ($parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use TestBase;
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
mySub(1);
tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}
Perl OO
#! /usr/bin/perl
#The base class to inherit from
package TestBase;
use strict;
use warnings;
#-------------------------------
sub new { my $s={ };
return bless $s;
}
sub tbSub
{
my ($self,$parm) = #_;
print "\nTestBase: $parm\n";
}
1;
.
#! /usr/bin/perl
#The descendent class
use strict;
use warnings;
use TestBase;
sub main;
sub mySub;
#-------------------------------
#Entry point...
main();
#---code------------------------
sub main
{
my $tb = TestBase->new();
mySub(1);
$tb->tbSub(2);
mySub(3);
}
#-------------------------------
sub mySub
{
my $parm = shift;
print "\nTester: $parm\n";
}
Perl's inheritance inherits methods, not functions. That means you will have to call
main->tbSub(2);
However, what you really want is to inherit the method into a proper class:
package Derived;
use base "TestBase";
package main;
Derived->somemethod("foo");
Calling methods in the current package as functions won't pass in the $self or "this" object nor the class name magically. Internally,
Class->somemethod("foo")
essentially ends up being called as
Class::somemethod("Class", "foo")
internally. Of course, this assumes Class has a subroutine/method named "somemethod". If not, the superclasses of Class will be checked and if those don't have a method "somemethod" either, you'll get a fatal error. (Same logic applies for $obj->method("foo").)
OO syntax uses the -> operator to separate the message and arguments from the receiver of the message. A short illustration below.
You->do_something( #params );
OR
$you->do_something( #params );
package A;
sub do_neat_thing {
my ( $class_or_instance, #args ) = #_;
my $class = ref( $class_or_instance );
if ( $class ) {
say "Instance of '$class' does a neat thing.";
}
else {
say "$class_or_instance does a neat thing.";
}
}
...
package main;
A->do_neat_thing(); # A does a neat thing.
my $a_obj = A->new();
$a_obj->do_neat_thing(); # Instance of 'A' does a neat thing.