I'm modularizing my code, but when I move a sub out of it's original module, I get the following error:
Couldn't load application from file "foo.pl": Not an ARRAY reference at D.pm line 10.
This was the original file. As is, it's all ok:
FormerC.pm:
package FormerC;
use strict;
my %my_hash = ( key => 'value' );
my #my_array = qw( some strings inside array );
sub problematic_sub {
my ($hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
};
sub uses_problematic_sub {
problematic_sub(\%my_hash, \#my_array);
};
uses_problematic_sub();
1
These are the two new modules. With these I get the error:
D.pm:
package D;
use strict;
sub new { bless {}, shift };
sub problematic_sub {
my ($hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
};
1
C.pm:
package C;
use strict;
use D;
my $d = D->new;
my %my_hash = ( key => 'value' );
my #my_array = qw( some strings inside array );
sub uses_problematic_sub {
$d->problematic_sub(\%my_hash, \#my_array);
};
uses_problematic_sub();
1
You used to call problematic_sub as a sub
problematic_sub(\%my_hash, \#my_array);
but you now call is as a method:
$d->problematic_sub(\%my_hash, \#my_array);
Since you didn't code problematic_sub as a method, this isn't correct. You need to also change problematic_sub's parameters to the following:
my ($self, $hash_ref, $array_ref) = #_;
You are likely to be better off using the Exporter module to export the subroutine names into the calling code's namespace. What you have written here is an object-oriented module, but the object is just a collection of subroutines and doesn't need object-oriented support.
The problem is that a method call like
$d->problematic_sub(\%my_hash, \#my_array)
implicitly passes the object as the first parameter, so it is equivalent to
D::problematic_sub($d, \%my_hash, \#my_array)
All you need to do is account for this in the subroutine
sub problematic_sub {
my ($self, $hash_ref, $array_ref) = #_;
my #an_array = #$array_ref;
return \#an_array;
}
and your code should work.
Also note that a subroutine declaration, like a while or for loop, is not a statement and so doesn't need and shouldn't have a semicolon after it.
Related
I'm trying to make subroutine closure working like an object.
However, I cannot call the returned subs references properly.
I receive Not a CODE reference at .\closure.pl line 22. error.
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my $val = sub { $value };
my $inc = sub { ++$value };
my $dec = sub { --$value };
my %api = (
'val' => \$val,
'inc' => \$inc,
'dec' => \$dec,
);
return %api;
}
my %numb = number(42);
$numb{'inc'}->();
print $numb{'val'}->();
How to fix the code?
Code fixed
Yes, of course, an anonymous definition must return a reference. it means that it can be put directly in the %api. Perl doesn't complain and works like a charm :)
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my %api = (
'val' => sub { $value },
'inc' => sub { ++$value },
'dec' => sub { --$value },
);
return \%api;
}
my $m = number(14);
my $n = number(41);
$m->{'dec'}->();
$n->{'inc'}->();
print $m->{'val'}->() . "\n"; # -> 13
print $n->{'val'}->() . "\n"; # -> 42
As discussed in perlref, the sub keyword without a name creates an anonymous subroutine and returns a reference to it. So you don't need to create another level of reference using the backslash; just pass the reference you already have as the value in the hash.
Is it possible to provide a hook in Perl to make sure no Hash key lookup fails ?
Example :
use strict;
use warnings;
my %hash_example = ( "a"=>"apple", "b"=>"ball" );
print $hash_example{"a"}; # Goes Fine.
print $hash_example{"c"}; # Throws Warning ( "Use of uninitialized value " ).
Codepad link
Whenever a hash lookup happens, some subroutine could get called which can provide a default value.
I mean, any hash lookup should call a sub ( say "get_hash_value (hash_ref, key) " ) and pass the hash and key to it. A sample of such a sub is shown below :
sub get_hash_value {
my $hash_ref = shift;
my $key = shift;
if ( exists $hash_ref->{$key} ) { # For Normal Lookup.
return $hash_ref->{$key};
}
else {
# This is the interesting place where we could provide our own values.
return "custom_value_based_on_certain_conditions"; # Some value
}
}
Another consequence would be the ability to alter the value returned against a key. We would be able to return a different value than what actually is stored against that key ( in that hash ).
There might not be a valid use case for this but am intrigued and would like to learn if such things are supported in Perl.
As said by Сухой27 in comment, this works fine:
my %hash_example = ( "a"=>"apple", "b"=>"ball" );
print $hash_example{"a"};
print $hash_example{"c"} // "custom_value_based_on_certain_conditions";
Doc on logical defined or
I would suggest that trying to alter how a hash lookup "works" is a really terrible idea, as a good way to create code that's hard to maintain.
However instead I would suggest you look at creating an object instead of a hash. They are basically the same thing, but an object includes code, and there is an expectation that the code within the object is 'doing it's own thing'.
So at a basic level:
#!/usr/bin/env perl
use strict;
use warnings;
package Hash_Ob;
sub new {
my ($class) = #_;
my $self = {};
bless( $self, $class );
return $self;
}
sub get_value {
my ( $self, $valuename ) = #_;
if ( $self->{$valuename} ) {
return $self->{$valuename};
}
else {
#generate your own value here!
$self->{$valuename} = 42;
return $self->{$valuename};
}
}
1;
Which you'd then 'call' using:
#!/usr/bin/env perl
use strict;
use warnings;
use Hash_Ob;
my $magic_hash = Hash_Ob -> new();
print $magic_hash -> get_value('new_value');
This avoids the problem of altering how a 'well known' mechanism actually works, and so future maintenance programmers will not curse your name.
Then maybe you want to use a tied hash. Tying is a mechanism to change the behavior of a builtin data type. See perltie for the gory details.
{
package HashWithDefault;
use Tie::StdHash;
our #ISA = qw(Tie::StdHash); # inherit STORE, FIRST, NEXT, etc.
sub TIEHASH {
my ($pkg,$default_val) = #_;
return bless { __default_val__ => $default_val}, $pkg;
}
sub FETCH {
my ($self,$key) = #_;
exists $self->{$key} ? $self->{$key} : $self->{__default_val__};
}
sub CLEAR { # don't clear the default val
my $self = shift;
%$self = ( __default_val__ => $self->{__default_val__} );
}
}
tie my %hash, 'HashWithDefault', "42";
%hash = (foo => 123, bar => 456);
print $hash{foo}; # 123
print $hash{quux}; # 42
I followed what friedo said here.
Now, when I try to call the method testScript I get the error global symbol $obj requires explicit package name and it fails to call testScriptTwo.
use strict;
use warnings;
package Test;
use Method::Signatures;
method new {
my $obj = bless {}, $self;
return $obj;
}
method testScript {
$obj->testScriptTwo(); # Error happens here
}
method testScriptTwo { ... }
Test script:
use Test;
my $class = Test->new();
$class->testScript();
How do I make use of $obj to call methods within the package itself?
Use this instead:
method testScript {
$self->testScriptTwo();
}
The first argument is in the variable $self, not $obj
Your questions seem to indicate you do not understand the basics of scope, and how plain Perl objects work.
In Perl, when you use the ->method syntax on a package name or blessed reference, the subroutine method in that package is invoked. The first argument to the subroutine is the thing on which you invoked method.
So, if you do
My::Friend->new('Alfred');
the new subroutine in the package My::Friend receives two arguments. My::Friend and Alfred.
In a new method, it is customary to refer to the first argument as $class, but that is completely up to you. You could use $basket_case if you were so inclined:
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
If you then invoke a method on the returned reference, that method will receive said reference as its first argument, allowing you to access data stored in that reference:
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
Putting it all together:
#!/usr/bin/env perl
package My::Package;
use strict;
use warnings;
sub new {
my $basket_case = shift;
my $basket = shift;
my $obj = bless { name => $basket } => $basket_case;
return $obj;
}
sub blurb {
my $schmorp = shift;
print $schmorp->{name}, "\n";
return;
}
sub derp {
my $herp = shift;
printf "%s derp derp\n", $herp->{name};
return;
}
package main;
my $x = My::Package->new('Alfred');
$x->blurb;
$x->derp;
Output:
Alfred
Alfred derp derp
You need to understand these basics. Trying to put another layer of abstraction on top of the basics before understanding what is underneath will not make things any easier.
Now, if you are using Method::Signatures, it, by convention, puts that implicit first argument in a lexically scoped variable which, by default, it calls $self.
You can override that name in specific methods, and doing so in new might be a good idea to convey the fact that it doesn't expect an object instance; instead it returns a new instance.
Whatever you called that lexically scoped instance variable in one sub does not affect what it is called in another sub. For example:
#!/usr/bin/env perl
use strict;
use warnings;
sub a_number {
my $number = int(rand(10));
return $number;
}
sub square_that_number {
my $x = shift;
return $x * $x;
}
my $bzzzt = a_number();
my $trrrp = square_that_number($bzzzt);
print $trrrp, "\n";
Output:
$ ./zt.pl
36
OK, you need to backtrack a bit - you're new method is broken in the first place, which indicates that you don't really understand what's going on with OO perl.
A very simple object looks like this:
package Foo;
sub new {
#when Foo -> new is called, then 'Foo' is passed in as the class name
my ( $class ) = #_;
#create an empty hash reference - can be anything, but $self is the convention
my $self = {};
#tell perl that $self is a 'Foo' object
bless ( $self, $class );
#return the reference to your `Foo` object
return $self;
}
sub set_name {
my ( $self, $new_name ) = #_;
$self -> {name} = $new_name;
}
sub get_name {
my ( $self ) = #_;
return $self -> {name};
}
When you call this in your code:
use Foo;
my $new_instance = Foo -> new();
The class is passed into the new method, which you then use bless to create an instantiated object.
Then you can 'do stuff' with it - when you 'call' a method using -> then the first argument into the subroutine is the object reference.
So
$new_instance -> set_name ( "myname" );
print $new_instance -> get_name();
Is equivalent to:
Foo::set_name($new_instance, "myname" );
print Foo::get_name($new_instance);
You act on $new_instance which is a sort of magic hash that allows you to include code.
Method::Signatures is largely irrelevant until you understand the basics of OO. But what that does is 'simply' expand the functions within a module, such that you don't have to extract self/class etc.
By default, a method defined as method provides $self automatically. no $obj like you're using. That's a variable that's local to you new method, and simply doesn't exist outside that.
I am trying to call subroutines from one controller file to another when I am writing the following code:
Abc.pm This is the file I have the code that I need to call a subroutine to another controller file. The following subroutine I need to call.
package MyApp::Controller::Abc;
use Moose;
use IO::File;
use Data::Dumper;
use MyApp::MyConfig;
use MyApp::DateUtils;
use MyApp::Arrs::API;
use MyApp::Constants;
use namespace::autoclean;
sub get_token_id :Private
{
my $self = shift;
my $c = $self->context;
my $myDBI = $c->model('MyDBI')->new;
return $myDBI->get_token_id;
}
The above code I need to call to Def.pm file. Now I am calling as following:
package MyApp::Controller::Def;
use Moose;
use namespace::autoclean;
use MyApp::Utils;
BEGIN { extends 'Catalyst::Controller'; }
my($self, $c) = #_;
my ($State, $Zip, $Country) = #_;
my $tokenid = $self->get_token_id;
I am getting the following error:
Can't call method "get_token_id" on an undefined value
But I need to call as following only:
When I am using the following code:
package MyApp::Controller::Def;
use Moose;
use namespace::autoclean;
use MyApp::Utils;
BEGIN { extends 'Catalyst::Controller'; }
my $self = shift;
my $c = $self->context;
my ($State, $Zip, $Country) = #_;
my $coid = $self->get_token_id;
I am getting this error:
Can't call method "context" on an undefined value
Can any one help me why I am getting this error.
Thanks in advance...
The root cause here appears to be that you're not instantiating your objects properly.
Using:
$self = shift;
is an object oriented notation, and it makes no sense if you're doing it outside a subroutine - which is what appears to be happening here. And more specifically - a subroutine that's called as a method, using $object -> subname($some_parameter);. If you do this, then perl passes a reference to the object as the first argument to the subroutine - which is where things like:
sub my_method {
my $self = shift;
$self -> {some_attribute} = 1;
$self -> some_other_method(#args);
}
or
sub some_other_method {
my ( $self, #args ) = #_;
foreach ( #args ) {
print;
}
}
type notation kicks in.
You're not doing this - you're 'shifting' in the body of a module, which will have no #_ it's undefined, and then you're trying to call a context method within an undefined object. Hence the error. get_token_id has the same root cause.
I can't easily offer advice on how to fix it, because it's hard to be sure what you're actually trying to do. I would suggest reviewing how OO perl works though, as a refresher might be beneficial.
I want to share a variable between different perl modules. So I created a perl module called MyCache.pm which saves the variable (in my case a hash variable):
package PerlModules::MyCache;
my %cache = ();
sub set {
my ($key, $value) = #_;
$cache{$key} = $value;
}
sub get {
my ($key) = #_;
return $cache{$key};
}
Now I have two handlers. The one handler will call the set method and the other one will call the get method to access the information.
package PerlModules::MyCacheSetter;
use Apache2::RequestRec();
use Apache2::RequestIO();
use Apache2::Const -compile => qw(OK);
use PerlModules::MyCache;
sub handler {
my $r = shift;
PerlModules::MyCache::set('test1', "true");
PerlModules::MyCache::set('test2', "false");
PerlModules::MyCache::set('test3', "true");
return Apache2::Const::OK;
}
And here is the getter handler:
package PerlModules::MyCacheGetter;
use Apache2::RequestRec();
use Apache2::RequestIO();
use Apache2::Const -compile => qw(OK);
use PerlModules::MyCache;
sub handler {
my $r = shift;
$r->print(PerlModules::MyCache::get('test1'));
$r->print(PerlModules::MyCache::get('test2'));
$r->print(PerlModules::MyCache::get('test3'));
return Apache2::Const::OK;
}
Now I've configured apache (via http.conf) to access these perl modules. I run the setter handler and then the getter, but there was no output.
In the error.log there are now some entries:
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 14.
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 15.
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 16.
This lines are the three calls of the get method. So what am I doing wrong? How can I fix the problem and share my cache variable between different handlers?
Your cache will only exist for the lifetime of a given Apache child process. If you want other processes to see it, you'll need to store it somewhere they can all get at it.
This is untested, but you can get the general idea: (Now tested).
EDIT: OK, it seems like you can get some issues with Storable depending on what perl version and Storable version you're running. I've replaced Storable with Data::Serialize in my example. I've also added a line to the get/set methods so that either the -> or :: syntax can be used.
package PerlModules::MyCache;
use IPC::ShareLite qw/:lock/;
use Data::Serializer;
use 5.10.0;
my $key = 1234; # Your shared memory key (you set this!)
my $ipc = IPC::ShareLite->new(
-key => $key,
-create => 'yes',
-destroy => 'no'
);
my $ser = Data::Serializer->new(
serializer => 'Data::Dumper'
);
sub set {
shift #_ if $_[0] eq __PACKAGE__;
my ($key, $value) = #_;
$ipc->lock(LOCK_EX);
my $frozen; eval { $frozen = $ipc->fetch; };
my $cache = defined($frozen) ? $ser->thaw($frozen) : {};
$cache->{$key} = $value;
$ipc->store($ser->freeze($cache));
$ipc->unlock;
return $value;
}
sub get {
shift #_ if $_[0] eq __PACKAGE__;
my ($key) = #_;
my $frozen; eval { $frozen = $ipc->fetch; };
my $cache = defined($frozen) ? $ser->thaw($frozen) : {};
return $cache->{$key};
}
sub clear {
shift #_ if $_[0] eq __PACKAGE__;
$ipc->store($ser->freeze({}));
return {};
}
1;
You might want to run PerlModules::MyCache->clear once before you test to ensure the correct structure of the cache storage.