How can I catch access to member variables?
$Class1->{Class2}
If the Class2 field doesn't exist, is is possible to catch this from an internal function?
You can, but you probably shouldn't. The problem here is - if you access a variable within a class directly... then you just can. You can prevent this with a couple of workarounds - and this is where things like Moose come in.
And there's a couple of slightly hacky tricks like inside-out objects (which I think aren't common practice any more - Perl Best Practice advocated them some years back) or using anonymous hashes to hold state.
But failing that - why not use an accessor, and auto-generate one using 'AUTOLOAD'.
#!/usr/bin/env perl
package MyClass;
use strict;
use warnings;
use vars '$AUTOLOAD';
sub AUTOLOAD {
my ( $self ) = #_;
my $subname = $AUTOLOAD =~ s/.*:://r;
if ( $self -> {$subname} ) {
return $self -> {$subname};
}
warn "Sub called $subname was called\n";
return "$subname";
}
sub new {
my ( $class ) = #_;
my $self = {};
bless $self, $class;
}
package main;
use strict;
use warnings;
my $object = MyClass -> new;
$object -> {var} = "fleeg";
print "Undef fiddle was: ", $object -> fiddle,"\n";
print "But 'var' was: ", $object -> var,"\n";
This has the same problem, in that changing method names might cause things to break. However it has the advantage that you can handle 'invalid' method calls however you like.
But really - explicit 'get' and 'set' methods are better choices for most use-cases.
You do this by providing proper getter/setter methods that wrap around your class/instance variables. The internals should never be accessed directly, particularly from outside of the class itself (it's wise to not do so within the class either, except for the actual method that maintains that specific attribute. Here's a very basic example:
use warnings;
use strict;
package A;
sub new {
my ($class, %args) = #_;
my $self = bless {}, $class;
$self->x($args{x});
$self->y($args{y});
return $self;
}
sub x {
my ($self, $x) = #_;
$self->{x} = $x if defined $x;
return $self->{x} // 1;
}
sub y {
my ($self, $y) = #_;
$self->{y} = $y if defined $y;
return $self->{y} // 2;
}
package main;
my $obj = A->new(x => 5, y => 3);
print $obj->x ."\n";
print $obj->y ."\n";
Now, you could just as easily do print $obj->{x}, but that's where your problem is. What happens when the code is much more complicated than this, and for some reason you want to change the x attribute name to foo, but retain the x() method? $obj->{x} will now be undef as its never set.
Always use the provided methods for accessing attributes of a class/object. Encapsulation such as this is a staple of OO programming.
Related
If perlcritic says "having no returns in a sub is wrong", what is the alternative if they really aren't needed?
I've developed two apparently bad habits:
I explicitly assign variables to the '$main::' namespace.
I then play with those variables in subs.
For example, I might do..
#!/usr/bin/perl
use strict;
use warnings;
#main::array = (1,4,2,6,1,8,5,5,2);
&sort_array;
&push_array;
&pop_array;
sub sort_array{
#main::array = sort #main::array;
for (#main::array){
print "$_\n";
}
}
sub push_array{
for ( 1 .. 9 ){
push #main::array, $_;
}
}
sub pop_array {
for ( 1 .. 3 ){
pop #main::array;
}
}
I don't do this all the time. But in the above, it makes sense, because I can segregate the operations, not have to worry about passing values back and forth and it generally looks tidy to me.
But as I said, perl critic says its wrong - because there's no return..
So, is anyone able to interpret what I'm trying to do and suggest a better way of approaching this style of coding in perl? eg. am I sort of doing OOP?
In short - yes, you're basically doing OO, but in a way that's going to confuse everyone.
The danger of doing subs like that is that you're acting at a distance. It's a bad coding style to have to look somewhere else entirely for what might be breaking your code.
This is generally why 'globals' are to be avoided wherever possible.
For a short script, it doesn't matter too much.
Regarding return values - Perl returns the result of the last expression by default. (See: return)
(In the absence of an explicit return, a subroutine, eval, or do FILE automatically returns the value of the last expression evaluated.)
The reason Perl critic flags it is:
Require all subroutines to terminate explicitly with one of the following: return, carp, croak, die, exec, exit, goto, or throw.
Subroutines without explicit return statements at their ends can be confusing. It can be challenging to deduce what the return value will be.
Furthermore, if the programmer did not mean for there to be a significant return value, and omits a return statement, some of the subroutine's inner data can leak to the outside.
Perlcritic isn't always right though - if there's good reason for doing what you're doing, then turn it off. Just as long as you've thought about it and are aware of the risks an consequences.
Personally I think it's better style to explicitly return something, even if it is just return;.
Anyway, redrafting your code in a (crude) OO fashion:
#!/usr/bin/perl
use strict;
use warnings;
package MyArray;
my $default_array = [ 1,4,2,6,1,8,5,5,2 ];
sub new {
my ( $class ) = #_;
my $self = {};
$self -> {myarray} = $default_array;
bless ( $self, $class );
return $self;
}
sub get_array {
my ( $self ) = #_;
return ( $self -> {myarray} );
}
sub sort_array{
my ( $self ) = #_;
#{ $self -> {myarray} } = sort ( #{ $self -> {myarray} } );
for ( #{ $self -> {myarray} } ) {
print $_,"\n";
}
return 1;
}
sub push_array{
my ( $self ) = #_;
for ( 1 .. 9 ){
push #{$self -> {myarray}}, $_;
}
return 1;
}
sub pop_array {
my ( $self ) = #_;
for ( 1 .. 3 ){
pop #{$self -> {myarray}};
}
return 1;
}
1;
And then call it with:
#!/usr/bin/perl
use strict;
use warnings;
use MyArray;
my $array = MyArray -> new();
print "Started:\n";
print join (",", #{ $array -> get_array()} ),"\n";
print "Reshuffling:\n";
$array -> sort_array();
$array -> push_array();
$array -> pop_array();
print "Finished:\n";
print join (",", #{ $array -> get_array()} ),"\n";
It can probably be tidied up a bit, but hopefully this illustrates - within your object, you've got an internal 'array' which you then 'do stuff with' by making your calls.
Result is much the same (I think I've replicated the logic, but don't trust that entirely!) but you have a self contained thing going on.
If the function doesn't mean to return anything, there's no need to use return!
No, you don't use any aspects of OO (encapsulation, polymorphism, etc). What you are doing is called procedural programming. Nothing wrong with that. All my work for nuclear power plants was written in that style.
The problem is using #main::array, and I'm not talking about the fact that you could abbreviate that to #::array. Fully-qualified names escape strict checks, so they are far, far more error-prone. Mistyped var name won't get caught as easily, and it's easy to have two pieces of code collide by using the same variable name.
If you're just using one file, you can use my #array, but I presume you are using #main::array because you are accessing it from multiple files/modules. I suggest placing our #array in a module, and exporting it.
package MyData;
use Exporter qw( import );
our #EXPORT = qw( #array );
our #array;
1;
Having some kind of hint in the variable name (such as a prefix or suffix) indicating this is a variable used across many modules would be nice.
By the way, if you wanted do create an object, it would look like
package MyArray;
sub new {
my $class = shift;
my $self = bless({}, $class);
$self->{array} = [ #_ ];
return $self;
}
sub get_elements {
my ($self) = #_;
return #{ $self->{array} };
}
sub sort {
my ($self) = #_;
#{ $self->{array} } = sort #{ $self->{array} };
}
sub push {
my $self = shift;
push #{ $self->{array} }, #_;
}
sub pop {
my ($self, $n) = #_;
return splice(#{ $self->{array} }, 0, $n//1);
}
my $array = MyArray->new(1,4,2,6,1,8,5,5,2);
$array->sort;
print("$_\n") for $array->get_elements();
$array->push_array(1..9);
$array->pop_array(3);
I improved your interface a bit. (Sorting shouldn't print. Would be nice to push different things and to pop other than three elements.)
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.
How do you make one setter method, and one getter method to manage access to fields of an object? The new subroutine looks like this:
sub new {
my $class = shift;
my $self = {#_};
bless($self,$class); # turns this into an object
}
Creation of a new object looks like this:
$foo = Package::new("Package",
"bar", $currentBar,
"baz", $currentBaz,
);
This is not a good idea.
Perl instituted the use of use strict; to take care of problems like this:
$employee_name = "Bob";
print "The name of the employee is $employeeName\n";
Mistyped variable names were a common problem. Using use strict; forces you to declare your variable, so errors like this can be caught at compile time.
However, hash keys and hash references remove this protection. Thus:
my $employee[0] = {}
$employee[0]->{NAME} = "Bob";
print "The name of the employee is " . $employee[0]->{name} . "\n";
One of the reasons to use objects when you start talking about complex data structures is to prevent these types of errors:
my $employee = Employee->new;
$employee->name("Bob");
print "The name of the employee is " . $employee->Name . "\n";
This error will get caught because the method name is name and not Name.
Allowing users to create their own methods at random removes the very protection we get by using objects:
my $employee = Employee->new;
$employee->name("Bob"); #Automatic Setter/Getter
print "The name of the employee is " . $employee->Name . "\n"; #Automatic Setter/Getter
Now, because of automatic setters and getters, we fail to catch the error because any method the user names is valid -- even if that user made a mistake.
In fact, I setup my objects so my object doesn't necessarily know how it's structured. Observe the following class with methods foo and bar:
sub new {
my $class = shift;
my $foo = shift;
my $bar = shift;
my $self = {};
bless $self, $class;
$self->foo($foo);
$self->bar($bar);
return $self;
}
sub foo {
my $self = shift;
my $foo = shift;
my $method_key = "FOO_FOO_FOO_BARRU";
if (defined $foo) {
$self->{$method_key} = $foo;
}
return $self->{$method_key};
}
sub bar {
my $self = shift;
my $bar = shift;
my $method_key = "BAR_BAR_BAR_BANNEL";
if (defined $bar) {
$self->{$method_key} = $bar;
}
return $self->{$method_key};
}
I can set the class values for foo and bar in my constructor. However, my constructor doesn't know how those values are stored. It simply creates the object and passes it along to my getter/setter methods. Nor, do my two methods know how they store each other's value. That's why I can have such crazy names for my method's hash keys because that is only available in the method and no where else.
Instead, my methods foo and bar are both setters and getters. If I give them a value for foo or bar, that value is set. Otherwise, I simply return the current value.
However, I'm sure you already know all of this and will insist this must be done. Very well...
One way of handling what you want to do is to create an AUTOLOAD subroutine. The AUTOLOAD subroutine automatically is called when there's no other method subroutine by that name. The $AUTOLOAD contains the class and method called. You can use this to setup your own values.
Here's my test program. I use two methods bar and foo, but I could use any methods I like and it would still work fine
One change, I use a parameter hash in my constructor instead of a list of values. No real difference except this is considered the modern way, and I just want to be consistent with what everyone else does.
Also notice that I normalize my method names to all lowercase. That way $object->Foo, $object->foo, and $object-FOO are all the same method. This way, I at least eliminate capitalization errors.
use strict;
use warnings;
use feature qw(say);
use Data::Dumper;
my $object = Foo->new({ -bar => "BAR_BAR",
-foo => "FOO_FOO",
}
);
say "Foo: " . $object->foo;
say "Bar: " . $object->bar;
$object->bar("barfu");
say "Bar: " . $object->bar;
say Dumper $object;
package Foo;
sub new {
my $class = shift;
my $param_ref = shift;
my $self = {};
bless $self, $class;
foreach my $key (keys %{$param_ref}) {
# May or may not be a leading dash or dashes: Remove them
(my $method = $key) =~ s/^-+//;
$self->{$method} = $param_ref->{$key};
}
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $value = shift;
our $AUTOLOAD;
( my $method = lc $AUTOLOAD ) =~ s/.*:://;
if ($value) {
$self->{$method} = $value;
}
return $self->{$method};
}
Something like this...
sub get {
my $self = shift;
my $field = shift;
return $self->{$field};
}
sub set {
my $self = shift;
my $field = shift;
$self->{$field} = shift;
}
...makes it possible to write
$obj->set(foo => 'my foo value');
print $obj->get('foo');
But nowadays, it is very common to just use Moose.
I'm working with a few Perl packages, we'll call them Some::Parser and Some::Data. A Some::Parser object has methods to return objects of type Some::Data. I have written a class that extends the Some::Data class, let's call it My::Data. Objects of class My::Data are really just objects of class Some::Data, but with additional methods that make it easier to work with.
My problem is that I want to continue to use the Some::Parser class to do the hard work of parsing the data. As I said earlier, Some::Parser objects give me Some::Data objects. Once I have a Some::Data object in hand, is there any way to reclassify it as a My::Data object? How would I do this?
I'm totally willing to change my approach, assuming someone can suggest a better way of doing what I want to do, but writing my own parser is not something I'm interested in doing!
This smells like a bit of a kludge. It might be time to rethink your strategy. For example, maybe you should write My::Parser which returns My::Data objects.
But if you don't want to do that, you can manually use bless to change an object's class:
my $obj = Some::Data->new;
bless $obj, 'My::Data';
See bless in perldoc.
Probably the best way to handle something like this is for Some::Parser to provide a way to specify the class it should be using for data objects. For example, HTML::TreeBuilder provides the element_class method. If you want TreeBuilder to produce something other than HTML::Element nodes, you subclass HTML::TreeBuilder and override element_class to return your desired node class. (The actual code in TreeBuilder is a bit more complex, because there was a different mechanism for doing this prior to HTML-Tree 4, and the new maintainer didn't want to break that.)
I take it that you didn't write Some::Parser, but perhaps it has this capability already. If not, maybe its maintainer will accept a patch. It should be a fairly simple change. You'd just add a data_class method (sub data_class { 'Some::Data' }), and then change Some::Data->new to $self->data_class->new. Then you can subclass Some::Parser to create My::Parser, and just override data_class.
You can rebless anything.
Inheritance in Perl 5 is nothing more than searching #ISA.
You can re-bless the returned object to whatever your heart desires:
#!/usr/bin/perl
package Some::Data;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub a { $_[0]->{a} }
package My::Data;
use strict; use warnings;
use base 'Some::Data';
sub a_squared {
my $self = shift;
my $v = $self->a;
return $v * $v;
}
package Some::Parser;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub parse { return Some::Data->new(a => 3) }
package main;
use strict; use warnings;
my $data = Some::Parser->new->parse;
bless $data => 'My::Data';
printf "%.1f\t%.1f\n", $data->a, $data->a_squared;
Alternatively, you can use #cjm's idea:
#!/usr/bin/perl
package Some::Data;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub a { $_[0]->{a} }
package My::Data;
use strict; use warnings;
use base 'Some::Data';
sub a_squared {
my $self = shift;
my $v = $self->a;
return $v * $v;
}
package Some::Parser;
use strict; use warnings;
sub new { my $class = shift; bless { #_ } => $class }
sub parse {
my $self = shift;
return $self->data_class->new(a => 3);
}
sub data_class { $_[0]->{data_class} }
package main;
use strict; use warnings;
my $data = Some::Parser->new(data_class => 'My::Data')->parse;
printf "%.1f\t%.1f\n", $data->a, $data->a_squared;
I'd consider re-blessing venturesome. Once you have an object you can't really tell if it was created using its constructor ( usually Foo::new() ), or someone re-blessed some other object.
The problem is, some constructors are fat, this means they do a whole lotta more than just blessing something:
sub new {
my $pkg = shift;
my ($required) = #_;
croak "Bad call" unless defined $required;
_do_something_magic ($required);
my $self = { 'foo' => $required };
return bless $self, $pkg;
}
In this case your re-blessed object might not be the one you'll expect later in code.
One may consider constructors with "re-blessing" functionality build in. But such "object converters" will make the design even more complicated.
Stick to the basic definition: "An object is an instance of the class. Forever.".
I'm trying to add some functionality to our code base by using tied scalars.
We have a function which is specified to return scalars. I thought I could add some features to the system by tie-ing these scalars before returning them, but it looks like the FETCH method is called just before the return, which results in an untied scalar being returned.
Is there any way around this?
I really want to keep the subroutine's interface (returning scalars) intact if it's at all possible.
use strict;
use warnings;
main();
sub GetThing{
my $thing;
tie $thing, 'mything', #_;
return $thing;
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
require Tie::Scalar;
my #ISA = qw(Tie::StdScalar);
sub TIESCALAR {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
Desired output:
1
ACCESS ALERT!
NAME: 'Fred'
2
ACCESS ALERT!
NAME: 'Fred'
3
I can get the desired output by returning a reference, and dereferencing on each access, but that ruins our established interface, and makes it more confusing for our users.
--Buck
As DVK said, tie applies to containers, so isn't useful for returned values.
For that, you use overloading. An example (not all the possible overloaded operations are supplied; see http://perldoc.perl.org/overload.html#Minimal-set-of-overloaded-operations):
use strict;
use warnings;
main();
sub GetThing{
my $thing;
$thing = "mything"->new(#_);
return $thing;
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
use overload 'fallback' => 1, '""' => 'FETCH';
sub new {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
As mentioned in other answers, tie applies to containers, and not to values, so there is no way to assign a tied variable to another variable and retain the tied properties.
Since assignment is out, you need to pass the container into the GetThing routine. You can do this by reference as follows:
use strict;
use warnings;
main();
sub GetThing{
tie ${$_[1]}, 'mything', $_[0];
}
sub main {
my %m;
GetThing('Fred' => \$m{pre});
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
require Tie::Scalar;
my #ISA = qw(Tie::StdScalar);
sub TIESCALAR {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
which produces the correct output.
However, if you want to retain the assignment, you will need to use overloading, which applies to values (actually to objects, but they themselves are values). Without more detail on your intended purpose it is hard to give a complete answer, but this will meet your stated requirements:
use strict;
use warnings;
main();
sub GetThing{
return mything->new( shift );
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
sub new {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
use overload '""' => sub { # '""' means to overload stringification
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
};
Both ties and overloads can get complicated, so read through all of the documentation if anything is not clear.
First, the exact method of doing what you are proposing seems technically impossible:
Tied variables have the tie attached to the variable itself, not to its value.
In Perl, subroutine's return values are returned by value, meaning you take the value passed to return, access it (in you case, accessing the tied variable and calling FETCH in the process) - and then copy that value! Which means that what the caller gets is a scalar VALUE, not a scalar variable (tied or untied).
Your confusion, in short, seems to stem from mixing together variables (locations in program's symbol table) and values stored in those variables.
Second, you were somewhat unclear as to what exactly you are trying to achieve, so it's hard to propose how to achieve what you want. But assuming, based on your description, that you wanted to call some method upon subroutine's return (possibly passing it the return value), you CAN do that.
To do so, you need to employ what fancy people call aspect programming. The politically (and technically) correct way of doing it in Perl is by using Moose.
However, you can DIY it, by basically replacing the original method with a wrapper method.
The exact mechanics of both Moose and DIY approaches can be seen in the first two answers to the following SO question, so I won't copy/paste them here, hope you don't mind:
Simulating aspects of static-typing in a duck-typed language
If you're feeling adventurous, you could also use the Scalar::Defer module which provides a general-purpose mechanism for a scalar variable to compute a value lazily, either once or on each access.