Perl OOP Blessing - perl

I'm new to Perl and I've been making my way through this tutorial http://qntm.org/files/perl/perl.html
Anyways, I'm working on creating a package that will take in a matrix and will perform various basic operations (i.e. gaussian elimination, rref, back sub, deterimants, etc). I have my constructor taking in a list of references, but I'm having some trouble blessing them so I can access them later. My code thus far:
main.pl:
use strict;
use warnings;
use Matrix;
my #list = ([1,1,1],[2,2,2]);
my $matrix = Matrix->new(#list);
$matrix->test();
Matrix.pm:
package Matrix;
sub new(){
my $class = shift;
my $self = [];
my #params = #_;
$self = \#params;
print scalar #{$self->[1]}; #just testing some output...(outputs 3 as expected)
bless $self,$class;
return $self;
}
sub test(){
print #{$self->[1]}; #does not output anything
}
1;
I'm assuming the problem is that the references that $self is referring to is not being blessed, but I'm not sure how to do this. Any help would be appreciated.
Thanks

You forgot to actually define $self in test; it's not available for you automatically. This is why you should always put use warnings; use strict; in every Perl source file: so that the compiler will tell you about errors like these. (Also, there's no point in writing sub new() instead of sub new, and likewise for test; the function prototype is not only wrong but will be flat-out ignored when new is used as a method, i.e., how new is supposed to be used.)

Related

How do you lock a member variable in perl?

I wrote a script in perl which does multi-threading, I then tried to convert it over into an object. However, I can't seem to figure out how to lock on a member variable. The closest I've come to is:
#!/usr/bin/perl
package Y;
use warnings;
use strict;
use threads;
use threads::shared;
sub new
{
my $class = shift;
my $val :shared = 0;
my $self =
{
x => \$val
};
bless $self, $class;
is_shared($self->{x}) or die "nope";
return $self;
}
package MAIN;
use warnings;
use strict;
use threads;
use threads::shared;
use Data::Dumper;
my $x = new Y();
{
lock($x->{x});
}
print Dumper('0'); # prints: $VAR = '0';
print Dumper($x->{x}); # prints: $VAR = \'0';
print "yes\n" if ($x->{x} == 0); # prints nothing
#print "yes\n" if ($$x->{x} == 0); # dies with msg: Not a SCALAR reference
my $tmp = $x->{x}; # this works. Must be a order of precedence thing.
print "yes\n" if ($$tmp == 0); # prints: yes
#++$$x->{x}; # dies with msg: Not a SCALAR reference
++$$tmp;
print Dumper($x->{x}); # prints: $VAR = \'1';
This allows me to put a lock on the member var x, but it means I'd be needing 2 member variables as the actual member var isn't really capable of being manipulated by assigning to it, incrementing it, etc. I can't even test against it.
EDIT:
I'm thinking that I should rename this question "How do you dereference a member variable in perl?" as the problem seems to boil down to that. Using $$x->{x} is invalid syntax and you can't force precedence rules with parentheses. I.e. $($x->{x}) doesn't work. Using a temporary works but it a nuisance.
I don't get what you are trying to do with threads and locking, but there are some simple errors in the way you use references.
$x->{x}
is a reference to a scalar, so the expressions
$x->{x} == 0
++$$x->{x}
both look suspect. $$x->{x} is parsed as {$$x}->{x} (dereference $x, then treat it as a hash reference and look up the value with key x). I think you mean to say
${$x->{x}} == 0
++${$x->{x}}
where ${$x->{x}} means to treat $x as a hash reference, to look up the value for key x in that hash, and then to dererence that value.

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' );

Odd number of elements in hash assignment error

I was learning Perl Objects. I wrote a simple constructor in a module file create_schedules.pm:
#!/usr/bin/perl -w
#
package create_schedules;
use strict;
use warnings;
use diagnostics;
sub new {
my $class = shift;
my %params = #_;
my $self=bless{
_para1=>$params{'mypara1'},
_para2=>$params{'mypara2'}
},$class;
return $self;
}
1;
and I am creating an object in a main file main.pl:
#!/usr/bin/perl -w
use strict;
use warnings;
use diagnostics;
use lib::my_module;
sub _start(){
print "Main Function Started\n";
create_schedules::new(
'mypara1' => 'This is mypara1',
'mypara2' => 'This is mypara2',
);
}
_start();
As soon as I run main.pl, I got following error:
Main Function Started
Odd number of elements in hash assignment at lib/create_schedules.pm line 9 (#1)
(W misc) You specified an odd number of elements to initialize a hash,
which is odd, because hashes come in key/value pairs.
Just call with:
create_schedules->new
# note ___^^
An old way to call was:
new create_schedules(...);
Why your code is wrong:
In the new method you're doing my $class = shift;, after that, #_ will contain only 3 elements:
'This is mypara1',
'mypara2',
'This is mypara2',
Then the instruction my %params = #_; will cause the warning about odd number of elements.
You used the function directly, not as an object:
create_schedules::new
#^^-- this
Instead of
create_schedules->new
When you do that, this line:
my $class = shift;
Does not contain the object, but the first element of your hash assignment. And if you remove one element, the list is now a number of elements that is odd.
Although I do note that your package names are not the same. You are using create_schedules in the main, and my_module in the module.

Perl, evaluate string lazily

Consider the following Perl code.
#!/usr/bin/perl
use strict;
use warnings;
$b="1";
my $a="${b}";
$b="2";
print $a;
The script obviously outputs 1. I would like it to be whatever the current value of $b is.
What would be the smartest way in Perl to achieve lazy evaluation like this? I would like the ${b} to remain "unreplaced" until $a is needed.
I'm more interested in knowing why you want to do this. You could use a variety of approaches depending on what you really need to do.
You could wrap up the code in a coderef, and only evaluate it when you need it:
use strict; use warnings;
my $b = '1';
my $a = sub { $b };
$b = '2';
print $a->();
A variant of this would be to use a named function as a closure (this is probably the best approach, in the larger context of your calling code):
my $b = '1';
sub print_b
{
print $b;
}
$b = '2';
print_b();
You could use a reference to the original variable, and dereference it as needed:
my $b = '1';
my $a = \$b;
$b = '2';
print $$a;
What you want is not lazy evaluation, but late binding. To get it in Perl, you need to use eval.
my $number = 3;
my $val = "";
my $x = '$val="${number}"';
$number = 42;
eval $x;
print "val is now $val\n";
Be advised that eval is usually inefficient as well as methodically atrocious. You are almost certainly better off using a solution from one of the other answers.
Perl will interpolate a string when the code runs, and i don't know of a way to make it not do so, short of formats (which are ugly IMO). What you could do, though, is change "when the code runs" to something more convenient, by wrapping the string in a sub and calling it when you need the string interpolated...
$b = "1";
my $a = sub { "\$b is $b" };
$b = "2";
print &$a;
Or, you could do some eval magic, but it's a bit more intrusive (you'd need to do some manipulation of the string in order to achieve it).
As others have mentioned, Perl will only evaluate strings as you have written them using eval to invoke the compiler at runtime. You could use references as pointed out in some other answers, but that changes the way the code looks ($$a vs $a). However, this being Perl, there is a way to hide advanced functionality behind a simple variable, by using tie.
{package Lazy;
sub TIESCALAR {bless \$_[1]} # store a reference to $b
sub FETCH {${$_[0]}} # dereference $b
sub STORE {${$_[0]} = $_[1]} # dereference $b and assign to it
sub new {tie $_[1] => $_[0], $_[2]} # syntactic sugar
}
my $b = 1;
Lazy->new( my $a => $b ); # '=>' or ',' but not '='
print "$a\n"; # prints 1
$b = 2;
print "$a\n"; # prints 2
You can lookup the documentation for tie, but in a nutshell, it allows you to define your own implementation of a variable (for scalars, arrays, hashes, or file handles). So this code creates the new variable $a with an implementation that gets or sets the current value of $b (by storing a reference to $b internally). The new method is not strictly needed (the constructor is actually TIESCALAR) but is provided as syntactic sugar to avoid having to use tie directly in the calling code.
(which would be tie my $a, 'Lazy', $b;)
You wish to pretend that $a refers to something that is evaluated when $a is used... You can only do that if $a is not truly a scalar, it could be a function (as cHao's answer) or, in this simple case, a reference to the other variable
my $b="1";
my $a= \$b;
$b="2";
print $$a;
I would like the ${b} to remain "unreplaced" until $a is needed.
Then I'd recommend eschewing string interpolation, instead using sprintf, so that you "interpolate" when needed.
Of course, on this basis you could tie together something quick(ish) and dirty:
use strict;
use warnings;
package LazySprintf;
# oh, yuck
sub TIESCALAR { my $class = shift; bless \#_, $class; }
sub FETCH { my $self = shift; sprintf $self->[0], #$self[1..$#$self]; }
package main;
my $var = "foo";
tie my $lazy, 'LazySprintf', '%s', $var;
print "$lazy\n"; # prints "foo\n"
$var = "bar";
print "$lazy\n"; # prints "bar\n";
Works with more exotic format specifiers, too. Yuck.

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.