I want to pass a hash reference to a module. But, in the module, I am not able to get the hash back.
The example:
#!/usr/bin/perl
#code.pl
use strict;
use Module1;
my $obj = new Module1;
my %h = (
k1 => 'V1'
);
print "reference on the caller", \%h, "\n";
my $y = $obj->printhash(\%h);
Now, Module1.pm:
package Module1;
use strict;
use Exporter qw(import);
our #EXPORT_OK = qw();
use Data::Dumper;
sub new {
my $class = $_[0];
my $objref = {};
bless $objref, $class;
return $objref;
}
sub printhash {
my $h = shift;
print "reference on module -> $h \n";
print "h on module -> ", Dumper $h, "\n";
}
1;
The output will be something like:
reference on the callerHASH(0x2df8528)
reference on module -> Module1=HASH(0x16a3f60)
h on module -> $VAR1 = bless( {}, 'Module1' );
$VAR2 = '
';
How can I get back the value passed by the caller?
This is an old version of perl: v5.8.3
In Module1, change sub printhash to:
sub printhash {
my ($self, $h) = #_;
# leave the rest
}
When you invoke a method on a object as $obj->method( $param1 ) the
method gets the object itself as the first parameter, and $param1 as the second parameter.
perldoc perlootut - Object-Oriented Programming in Perl Tutorial
perldoc perlobj - Perl Object Reference
When you call a sub as a method, the first value in #_ will be the object you called it on.
The first argument you pass to it will be the second value in #_, which you are currently ignoring.
sub printhash {
my ($self, $h) = #_;
Related
I found a solution to renaming anonymous subs in Perl here. It involves temporarily mangling the symbol table to insert the desired name. This solution uses a hard-coded symbol table name to be replaced. My problem is that I would like to dynamically choose the symbol table name at runtime. Something like this:
$pkg = 'MyPkg::ModA::';
$name = 'subname';
...
no strict 'refs';
local *{"${pkg}__ANON__"} = "$name [anon]";
strict refs;
The only way to make it work is to disable strict refs. If they are not disabled, the script fails with this message:
Can't use string ("MyPkg::ModA::__ANON__") as a symbol ref while "strict refs" in use at /path/to/source/File.pm line xx
Note that the equivalent statement could be used
local ${$pkg}{__ANON__} = "$name [anon]";
with the similar error message:
Can't use string ("MyPkg::ModA::") as a HASH ref while "strict refs" in use at /path/to/source/File.pm line xx
Is it possible to do the same thing without disabling strict refs?
TMI/DNR:
Here is a complete example in case you're interested. Ironically, my solution uses an anonymous sub to rename the given anonymous sub.
ModA.pm
package MyPkg::ModA;
use strict;
use warnings;
use MyPkg::Util;
# Create a new instance.
sub new
{
my ($type, $class, $self);
# allow for both ModA::new and $moda->new
$type = shift;
$class = ref $type || $type;
$self = {#_};
bless $self, $class;
# use exported Util::anon sub here
$self->{func} = anon sub
{
my ($arg);
$arg = shift;
debug "\$arg: $arg";
};
return $self;
} # new
1;
__END__
ModB.pm
package MyPkg::ModB;
use strict;
use warnings;
use MyPkg::ModA;
# Create a new instance.
sub new
{
my ($type, $class, $self);
# allow for both ModB::new and $modb->new
$type = shift;
$class = ref $type || $type;
$self = {#_};
bless $self, $class;
$self->{modA} = MyPkg::ModA->new;
return $self;
} # new
# Do something with ModA.
sub doit
{
my ($self);
$self = shift;
$self->{modA}->{func}->('What is your quest?');
} # doit
1;
__END__
Util.pm
package MyPkg::Util;
use strict;
use warnings;
require Exporter;
our (#ISA, #EXPORT);
#ISA = qw(Exporter);
#EXPORT = qw(
anon
debug);
# Temporarily mangle symbol table to replace '__ANON__'.
sub anon
{
my ($func, $sub, $pkg, $name);
$func = shift;
$sub = (caller 1)[3];
$sub =~ /(.*::)(.+)/;
$pkg = $1;
$name = $2;
return sub
{
# TODO How to do this w/o disabling strict?
#no strict 'refs';
# temp symbol table mangling here
# ${$pkg}{__ANON__} is equivalent to *{"${pkg}__ANON__"}
local *{"${pkg}__ANON__"} = "$name [anon]";
use strict;
$func->(#_);
};
} # anon
# Print a debug message.
sub debug
{
my($fname, $line, $sub);
($fname, $line) = (caller 0)[1,2];
$fname =~ s/.+\///;
$sub = (caller 1)[3] || 'main';
$sub =~ s/.*::(.+)/$1/;
printf STDERR "%-10s %s(%s) - \"%s\"\n", $fname, $sub, $line, "#_";
} # debug
1;
__END__
mytest.pl
#! /usr/bin/perl
use strict;
use warnings;
use MyPkg::ModB;
# Stuff happens here.
my ($modB);
$modB = MyPkg::ModB->new;
$modB->doit;
You can use core module Sub::Util's set_subname.
use Sub::Util qw( set_subname );
sub anon {
...
return set_subname("$name [anon]", $func);
}
I have a .pm Package Test file which contains:
sub new{
my $hash = shift;
my $self = {};
bless($self,$class);
$self->{hash} = %hash;
return $self;}
and
sub printer{
my $self = shift;
print("Test: ",$self->{hash},"\n");
return;}
On my main.pl I use:
$test = Test->new(%myhash);
I don't know if explained it properly but the problem is that I can't print my hash using my printer function.
I really appreciatte some help about it and if more information about it is needed I can paste all the files here.
The first argument to ->new is the class name. The arguments to the constructor come next. Not hardwiring the class name also makes inheritance possible.
Do you understand the difference between a hash and a hash reference? %hash is a hash, \%hash is a hash reference. If $test->{hash} contains a hash reference, you can dereference it (i.e. retrieve the hash from it) with %{ $test->{hash} }. Hash values must be scalars, which means you can't make a hash a value of a hash - but you can make a hash reference the value.
I'd also recommend to indent the code properly.
#! /usr/bin/perl
use warnings;
use strict;
{
package Test;
sub new {
my ($class, %hash) = #_;
bless { hash => \%hash }, $class;
}
sub printer {
my $self = shift;
print "Test: ", %{ $self->{hash} }, "\n";
}
}
my %hash = ( a => 11, b => 12 );
my $t = 'Test'->new(%hash);
$t->printer; # a11b12 or b12a11
I am well aware that there are several questions on a similar subjects but I fail to see how to apply the answers to my problem :
< Can't locate object method "idx" via package "1" >
What I don't understand is that I am using the same architecture in two packages and that it is OK in the first one... Where is the package "1" coming from ?
Here is the package that works fine :
package ObjA;
use warnings;
use strict;
use Data::Dumper;
use Carp;
use ObjB;
#CONSTRUCTOR AND INITIALISATION
sub new {
my $class = shift;
my $self = {#_};
bless($self,$class);
$self->language();
return $self;
}
sub load {
my $self = shift;
open (my $stream,"<",$self ->{name});
my #glob_xs=();
my $i = 0;
while (<$stream>){
$i += 1;
my #x = extract($stream,());
#glob_xs=(#glob_tokens,#x);
}
$self->tokens(\#glob_xs);
}
sub extract{
my ($stream,#x) = #_;
my $line = <$stream>;
chomp $line;
if ($line =~ /^\s*$/){
return #x;
}
print join("/",split("\t",$line));
my $b = ObjB::new(split("\t",$line));
push #x,$b->form;
extract_sentence($stream,#x);
}
# OBJECT ACCESSOR METHODS
sub language {$_[0]->{language}=$_[1] if defined $_[1] ; $_[0]->{language}}
1;
And here is the one that produces the error :
package ObjB;
use warnings;
use strict;
use Data::Dumper;
use Carp;
# CONSTRUCTOR AND INITIALISATION
sub new {
my $class = shift;
my $self = {#_};
bless($self,$class);
$self->idx(); # Dies here.
return $self;
}
# OBJECT ACCESSOR METHODS
sub idx {$_[0]->{idx}=$_[1] if defined $_[1] ; $_[0]->{idx}}
1;
Would it be because ObjB is called inside ObjA ? Or because they are declared in two different files ?
I truly hope someone will have an answer because I have been running in circles ...
Thank you !!
Obj::new is a method, but you call it as a subroutine.
ObjB::new(split("\t",$line));
This results in the value of first field of the line being used as the class, and that value is probably 1. You probably meant to use
ObjB->new(split("\t",$line));
I'm to learn Perl for a job interview over weekend. In order to get a deeper understanding I'm trying to implement a tree class.
#use strict;
#use warnings;
package Tree;
sub new {
my $class = shift #_;
my $content = shift #_;
my #array = shift #_;
return bless { "content" => $content, "array" => #array }, $class;
}
sub num_children {
my $self = shift #_;
my #array = $self->{"array"};
return scalar #array;
}
return 1;
To test the (faulty) tree class I have implemented the following test script.
#!/usr/bin/perl
require Tree;
my $t = Tree->new("#", undef);
my $tt = Tree->new("*", undef);
my $tttt = Tree->new("-", undef);
my $ttttt = Tree->new(".", undef);
my #list = ();
push #list, $tt;
push #list, $t;
push #list, $tttt;
push #list, $ttttt;
my $ttt = Tree->new("+", #list);
print $ttt->num_children();
Unfortunately the output is 1 instead of my expection of 4. I assume the array is somehow cut off or unvoluntarily converted to a scalar. Any Ideas?
The main problem is that you can't pass arrays as a single value—you have to pass a reference instead.
Also, you should never comment out use strict and use warnings. They are valuable debugging tools, and if you are getting error messages with them enabled you should fix the errors that they are flagging instead.
Here's a working Tree.pm
use strict;
use warnings;
package Tree;
sub new {
my $class = shift;
my ($content, $array) = #_;
return bless { content => $content, array => $array }, $class;
}
sub num_children {
my $self = shift;
my $array = $self->{array};
return scalar #$array;
}
1;
and the calling program tree_test.pl. Note that you should use rather than require a module.
#!/usr/bin/perl
use strict;
use warnings;
use Tree;
my #list = map { Tree->new($_) } ('#', '*', '-', '.');
my $ttt = Tree->new('+', \#list);
print $ttt->num_children, "\n";
output
4
shift only removes one element from an array. Populate #array without it:
my #array = #_;
But, you can't store an array in a hash directly, you have to use a reference:
return bless { content => $content,
array => \#array,
}, $class;
which you then have to dereference:
my #array = #{ $self->{array} };
return scalar #array
Currently I am making a new module and I was wondering how could I implement in my module 2 things.
We often see the use like:
use My::Module qw(something);
for example:
use CGI::Carp qw(fatalsToBrowser);
So the first question is, how do i
retrieve this, i mean wether the
user has specified anything and what
he specified ?
Second question is, How do i pass and read the args
directly on the constructor like
this:
my $my_module = My::Module->new(arg1,arg2,arg3);
AS requested on the comment the simple module test code:
package My::Module;
# $Id$
use strict;
use Carp;
sub new {
my $class = shift;
my $self = {};
$self->{ARG1} = undef;
$self->{ARG2} = undef;
$self->{ARG3} = undef;
$self->{ARG4} = undef;
bless($self,$class);
return $self;
}
sub arg1 {
my $self = shift;
if (#_) { $self->{ARG1} = shift }
return $self->{ARG1};
}
sub arg2 {
my $self = shift;
if (#_) { $self->{ARG2} = shift }
return $self->{ARG2};
}
sub arg3 {
my $self = shift;
if (#_) { $self->{ARG3} = shift }
return $self->{ARG3};
}
sub arg4 {
my $self = shift;
if (#_) { $self->{ARG4} = shift }
return $self->{ARG4};
}
sub dump {
my $self = shift;
require Data::Dumper;
my $d = Data::Dumper->new([$self], [ref $self]);
$d->Deepcopy(1);
return $d->Dump();
}
1; # so the require or use succeeds
perldoc -f use explains that the use keyword is simply loading a module during compile-time, and then calling ->import on it. The arguments a caller gave to the use statement will be passed to the import method call.
As for your second question: constructors are just methods. Getting their arguments works like it does for any other method or function, using the #_ variable.
import subroutine gets the arguments passed in a use. The following code samples should help you.
File: My/Module.pm
package My::Module;
use warnings;
use strict;
use Data::Dumper;
sub import {
my ( $package, #args ) = #_;
print Dumper \#args;
}
1;
File: module.pl
#!/usr/bin/env perl
use warnings;
use strict;
use My::Module qw(something);
If you are programming an object oriented module, you may try Moose which will save you lots of time.