Perl encapsulate class variable? - perl

I'm pretty new to perl, and I'm getting stuck on a homework problem. I have an object with a class variable that counts the number of instances created. Then I have a subclass with an instance variable.
My first question is, how do I make the class variable hidden from the user? I tried using closures but couldn't figure out how to make inheritance work with that. And the fact that it's a class variable made it worse because the code that increments it executed twice and it said I had two instances when I had one. Not exactly sure why it happened but it makes sense. I tried using scalars but the variable again wasn't incrementing correctly. Haven't tried "inside-out objects" yet and I'm not sure I want to, it seems way over my head. I'm getting the feeling that encapsulating class variables is different than encapsulating instance variables, but I can't find anything that explains how to do it.
My second questions is, as I mentioned, I can't get encapsulation to work with inheritance. With closures when you call the super constructor from the subclass you get a reference to the subroutine right, so there's no way (that I know of) to add the instance variables to that.
Here's my base class:
#!/usr/bin/perl -w
use strict;
package Base;
my $count = 1;
sub new {
my $class = shift;
my $self = {
_Count => $count # not hidden
};
$count++; # increment count
bless $self, $class;
return $self;
}
sub Count { # getter
my $self = shift;
return $self->{_Count};
}
1;
Here's my subclass:
#!/usr/bin/perl -w
use strict;
package Sub;
use Base;
our #ISA = qw(Base);
sub new {
my $class = shift;
my $self = $class->SUPER::New();
$self->{_Name} = undef; # not hidden
return $self;
}
sub Name { #getter/setter
my($self, $name) = #_;
$self->{_Name} = $name if defined($name);
return $self->{_Name};
}
1;

If you are using bare Perl 5 (rather than employing an OO framework), the usual way to do class variables is as a lexical visible only to the accessor:
{
my $count = 0;
sub Count {
my ($self, $new_count) = #_;
if (defined $new_count) { # NB only works if undef is not a legit value
$count = $new_count;
}
return $count;
}
}
$count is only visible in the enclosing block; not even other methods on the same class can see it. But anyone can manipulate it with either $base_obj->Count or Base->Count, and any such manipulation will affect the shared variable.
You can also employ closure to provide really-hidden instance variables. This is not worth doing unless you are fulfilling the arbitrary rules of a homework assignment.
package Base;
sub new {
my ($class, $name) = #_;
die "Need name!" unless defined $name;
my $age;
return bless sub {
my ($attribute, #args) = #_;
if ($attribute eq 'name') {
if (#args) {
die "Attempt to set read-only attribute!";
}
return $name;
}
if ($attribute eq 'age') {
if (#args) {
($age) = #args;
}
return $age;
}
die "Unknown attribute $attribute";
} => $class;
}
sub name {
my ($self, #args) = #_;
return $self->(name => #args);
}
sub age {
my ($self, #args) = #_;
return $self->(age => #args);
}
What happens here is that the blessed sub returned by new closes over two lexicals, $name and $age. When new returns, those lexicals go out of scope and the only way to access them from that point forward is through the closure. The closure can inspect its arguments to permit or deny access to the values it holds. So long as it never returns a reference, it can be sure that it has the only direct access to those variables.
This works with inheritance, too, without too much added subtlety:
package Derived;
use base 'Base';
sub new {
my ($class, $name, $color) = #_;
my $base_instance = $class->SUPER::new($name);
return bless sub {
my ($attribute, #args) = #_;
if ($attribute eq 'color') {
if (#args) {
($color) = #args;
}
return $color;
}
# base class handles anything we don't, possibly by dying
return $base_instance->($attribute, #args);
} => $class;
}
This emulates what languages with distinct storage for base- and derived-class instance data do, either handling the request locally or passing it on to the base class instance, which has been added to the closure. Deeper inheritance trees will result in closures that close over closures that close over closures, each of them optionally also closing over instance variables needed by that particular class.
This is a pretty big mess to produce and really hard to inspect and debug, which is why I'm going to emphasize one more time that you should never do this. But it is very useful to understand, to which end I refer you to SICP.

As a module-local my variable, $count is already hidden from users of the module/class. It appears as if you're using instance variable _Count as a "current ID" type variable, so that each object (instance) created gets a new ID starting from 1. (If instead it is meant to track the number of active instances, then you need to decrement it in DESTROY and there's no need to store a copy in the object.) If your test code is only creating one instance then its Count() method should return 1 but $count will be 2, since it started as 1 and was incremented after storing the old value in the object.
It is typical in perl to store instance variables in the $self hash as you are doing, without hiding them, although sometimes a prefix is used to avoid collisions. They are protected more by convention (it's not safe to rely on implementation details because they might change) than language features.
Take a look at the Moose suite of modules if you want higher-level control over perl classes.

To quote perldoc perlmodlib, "Perl does not enforce private and public parts of its modules as you may have been used to in other languages like C++, Ada, or Modula-17. Perl doesn't have an infatuation with enforced privacy. It would prefer that you stayed out of its living room because you weren't invited, not because it has a shotgun."
The standard convention in Perl is to put everything into the $self hash and use an underscore prefix to indicate which items should be treated as private... and then trust users of the class to respect that indication. The same convention is also applied to methods. If you use one of my modules and you choose to peek under the covers and modify the contents of $self directly or call $obj->_some_private_method, then you're going off into the woods and may break something, or what works fine in this version may break when you upgrade to the next version; if that happens, you get to keep both pieces.
If you're going to insist on making data inaccessible to anyone outside the class itself, there are ways to do that, but a) they add complexity which is, in almost all cases, unnecessary and b) as you've already seen, they have a tendency to make inheritance a lot more of a hassle to work with.
My question to you, then, is what are you actually attempting to accomplish and why do you feel the need to make your object data Sooper-Sekret and completely inaccessible? What benefit will you gain by doing so which isn't provided by simply marking things that you think should be treated as private, then trusting others to leave them alone (unless they have good reason to do otherwise)?

In Perl, fields are not usually hidden by enforcing this through the semantics of the language, but rather through a contract in the form of documentation. However, fields can be hidden through the use of closures. It is also worth noting that Perl does not semantically differentiate between class methods and instance methods.
One of the standard ways to implement objects is a blessed hash, like you do. This hash contains all instance variables / fields. It is customary to start "private" fields with an underscore. Usually, the contract (the documentation) will not state how these fields are stored, but will require the user of the class to go through various method calls.
Class variables should not be stored with the instance. It is better to use global variables, or lexical variables. In the code you gave, $count is just a counter, but you never access it as a class variable. Instead, you assign each instance an unique ID. To use it as a class variable, provide an appropriate accessor (I stripped out unneccessary stuff like returns):
{
package Base;
my $count = 0;
sub new {
my ($class) = #_;
my $self = {
ID => $count++,
};
bless $self, $class;
}
sub Count { $count }
sub ID { my ($self) = #_; $self->{ID} }
sub report { my ($self) = #_; "I am the Base object ".($self->ID)."." }
}
=head1 Base
A generic base class
=head2 Base->Count
Return the object count.
=head2 $base->ID
Give the unique ID of this object.
=head2 $base->report
Returns a string containing a short description.
=cut
The subclass has no business meddling with the count. This is enforced by the scope of the variable $count above, denoted via the outer curly braces. The subs are closures over this variable.
{
package Sub;
use parent -norequire, qw(Base); # remove `-norequire` if Base in different file
sub new {
my ($class) = #_;
my $self = $class->SUPER::new;
$self->{Name} = undef;
$self;
}
sub Name :lvalue {
my ($self) = #_;
$self->{Name};
}
sub report {
my ($self) = #_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
=head1 Sub
A generic subclass. It subclasses Base.
=head2 $sub->Name [= SCALAR]
Gets or sets the name of $sub.
my $oldname = $sub->Name;
$sub->name = "new name";
=cut
As you can see, the Sub constructor calls the Base initializer, then adds a new field. It has no class methods or class variables. The class has no access to the $count variable, except via the accessor class method. The contract is stated via POD documentation.
(In the Name method, I use an :lvalue annotation. This allows me to simply assign to the appropriate field in the object. However, this disallows argument checking.)
The testcase
my $base1 = Base->new; my $base2 = Base->new;
print "There are now " . Base->Count . " Base objects\n";
my $sub1 = Sub->new; my $sub2 = Sub->new;
print "There are now " . Base->Count . " Base objects\n";
$sub2->Name = "Fred";
print $_->report . "\n" for ($base1, $sub1, $base2, $sub2);
prints
There are now 2 Base objects
There are now 4 Base objects
I am the Base object 0.
I am the Sub object 2 called .
I am the Base object 1.
I am the Sub object 3 called Fred.
Beautiful, isn't it? (Except $sub1, that object is missing its name.)
The documentation can be viewed with perldoc -F FILENAME, and would output something like
Base
A generic base class
Base->Count
Return the object count.
$base->ID
Give the unique ID of this object.
$base->report
Returns a string containing a short description.
Sub
A generic subclass. It subclasses Base.
$sub->Name [= SCALAR]
Gets or sets the name of $sub.
my $oldname = $sub->Name;
$sub->name = "new name";
only typeset more nicely, if you are on a *nix system.
Tested under v5.12.4.
Edit: Inside-out objects
While inside-out objects provide better encapulation, they are a bad idea: difficult to understand, difficult to debug, and difficult to inherit they provide more problems than solutions.
{
package Base;
my $count = 0;
sub new { bless \do{my $o = $count++}, shift }
sub Count { $count }
sub ID { ${+shift} }
sub report { my ($self) = #_; "I am the Base object ".($self->ID)."." }
}
{
package Sub;
my #_obj = ();
my $count = 0;
sub new {
my ($class) = #_;
$count++;
$_obj[$count - 1] = +{
parent => Base->new(),
Name => undef,
};
bless \do{my $o = $count - 1}, shift;
}
sub Name :lvalue { $_obj[${+shift}]{Name} }
sub AUTOLOAD {
my $self = shift;
my $package = __PACKAGE__ . "::";
(my $meth = $AUTOLOAD) =~ s/^$package//;
$_obj[$$self]{parent}->$meth(#_)
}
sub report {
my ($self) = #_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
This implementation has the exact same interface, and completes the test case with the same output. This solution is far from optimal, supports only single inheritance, does some intermediate stuff (autoloading, dynamic method calls), but it does suprisingly work. Each object is actually just a reference to an ID that can be used to look up the actual hash containing the fields. The array holding the hashes is not accessible from the outside. The Base class has no fields, therefore no object array had to be created.
Edit2: Objects as coderefs
Yet another bad idea, but it is fun to code:
{
package Base;
my $count = 0;
sub new {
my ($class) = #_;
my $id = $count++;
bless sub {
my ($field) = #_;
die "Undefined field name" unless defined $field;
if ($field eq "ID") { return $id }
else { die "Unrecognised name $field" }
}, $class;
}
sub Count { $count }
sub ID { my ($self) = #_; $self->("ID") }
sub report { my ($self) = #_; "I am the Base object " . $self->ID . "." }
}
{
package Sub;
use parent -norequire, qw(Base);
sub new {
my ($class) = #_;
my $name = undef;
my $super = $class->SUPER::new;
bless sub {
my ($field, $val ) = #_;
die "Undefined field name" unless defined $field;
if ($field eq "Name") { defined $val ? $name = $val : $name }
else { $super->(#_) }
}, $class;
}
sub Name { my $self = shift; $self->("Name", #_) }
sub report {
my ($self) = #_;
"I am the Sub object ".($self->ID)." called ".($self->Name).".";
}
}
The test case has to be adapted to $sub2->Name("Fred"), and the documentation updated accordingly, as we cannot use an lvalue annotation here safely.

First, I'm not sure exactly what you mean by "hidden from the user", but it looks like you may be looking for package scoped variables (our) vs. instance scoped.
package MyBaseClass;
use warnings;
use strict;
our $counter = 0;
sub new {
my $class = shift;
$counter++;
return bless {}, $class;
}
sub howManyInstances {
return $counter;
}
1;
On your second question, I'm not sure what closures have to do with inheritance.
Here's a simple subclass:
package MySubClass;
use warnings;
use strict;
use parent 'MyBaseClass'; # use parent schema, don't mess with #ISA
sub new {
my $class = shift;
my $self = $class->SUPER::new(#_);
$self->{_name} = undef;
return $self;
}
# Your setter/getter looks ok as is, though lowercase is tradional for methods/subs
1;
Now, if this were real code you would not do it like this - you would use Moo or Moose.

Related

What is the default parameter for AUTOLOAD in Perl?

I've been playing with AUTOLOAD to create my accessors in Perl and I have encountered this confusion (I have searched google and perldoc already).
I have this code:
package Class;
sub new {
..code for constructor here.
}
sub AUTOLOAD {
my $name= shift;
print $name;
}
But when I do something like : my $a=Class->new; The autoload subroutine still executes, and prints Class=HASH(some weird number);
I thought AUTOLOAD only runs when there is an undefined method or subroutine?
And also I did this:
my $class = our $AUTOLOAD;
print $class #prints ::DESTROY
Am I right when I assumed that DESTROY is the value of $AUTOLOAD when no undefined function is passed?
Using Autoload is inherently difficult. If you want a solid object system that makes accessors for you then please use Moose, Mouse, Moo, or just loop over your fields and install the accessors yourself:
BEGIN {
my #fields = qw/foo bar baz/;
for my $field (#fields) {
no strict 'refs';
# install a closure in the package stash.
*{ __PACKAGE__ . "::" . $field } = sub {
my $self = shift;
$self->{$field} = shift if #_;
return $self->{$field};
};
}
}
If a class that can AUTOLOAD encounters an undefined method, the AUTOLOAD sub is called with the arguments of the missing sub. The fully qualified name of the requested sub is passed in the $AUTOLOAD package variable.
A typical Autoload sub would look like:
use Carp;
my %fields_allowed = map {$_ => 1} qw/foo bar baz/;
sub AUTOLOAD {
my $field = our $AUTOLOAD;
$field =~ s/.*:://; # strip the package name
$fields_allowed{$field}
or croak qq(Can't locate object method $field via package "#{[__PACKAGE__]}");
my $self = shift;
$self->{$field} = shift if #_;
return $self->{$field};
}
There remain two problems:
When the reference count of an object drops to zero, or when a thread terminates, the DESTROY method is called on the object if it provides one. We can prevent autoloading of DESTROY by providing an empty implementation: sub DESTROY {}.
We can ask any object if it can perform a certain method, like say "Good dog" if $dog->can("roll"). Therefore, we have to override can to support our autoloading. The can method is useful for safe duck typing. Every object inherits from UNIVERSAL, which provides default implementations for can and isa.
The contract of can is that it takes the name of a method. It will return undef when the object cannot perform the method, or a code reference to that method if it can. A suitable implementation would be
sub can {
my ($self, $name) = #_;
# check if it's a field of ours
if ($fields_allowed{$name}) {
return sub {
my $self = shift;
$self->{$name} = shift if #_;
return $self->{$name};
};
}
# Ask SUPER implementation of can if we can do $name
if (my $meth = $self->SUPER::can($name)) {
return $meth;
}
return; # no method found
}
We can now simplify AUTOLOAD to
sub AUTOLOAD {
my $field = our $AUTOLOAD;
$field =~ s/.*:://; # strip the package name
my $code = $self->can($field)
or croak qq(Can't locate object method $field via package "#{[__PACKAGE__]}");
goto &$code; # tail call; invisible via `caller()`.
}
This is a lot of complexity to get right. Verdict: Don't use Autoload because you think it might be less work. It never is. It is quite useful for implementing a proxy pattern, but that is a bit advanced.
I urge you to dabble around with OO basics, and the Moose object system, before diving deep into Perl's unique and strange features.

How to create (or not) class instance methods at construction time based on inputs?

How would I create my class such that some methods will exist in the instance only if certain values were passed to the constructor?
Perhaps a more generic way of asking is: How can I add a method to an existing class instance?
You can attach an anonymous sub to an object based on flags:
use strict;
use warnings;
package Object;
sub new {
my $class = shift;
my $self = bless {}, $class;
my %args = #_;
if ($args{method}) {
$self->{method} = sub { print "hello\n" }
}
return $self;
}
sub method {
my $self = shift;
if (not defined $self->{method}) {
warn "Not bound\n";
return;
}
$self->{method}->();
}
1;
to use:
use Object;
my $obj1 = Object->new(method=>1);
$obj1->method();
my $obj2 = Object->new();
$obj2->method();
You can extend this to a number of methods through the same interface.
You can use Moose to apply a role at runtime.
package My::Class;
use Moose;
has foo => ( isa => 'Str', is => 'ro', required => 1 );
sub BUILD {
my $self = shift;
if ($self->foo eq 'bar') {
My::Class::Role->meta->apply($self);
}
}
no Moose;
package My::Class::Role;
use Moose::Role;
sub frobnicate {
my $self = shift;
print "Frobnicated!\n";
}
no Moose;
my $something = My::Class->new( foo => 'bar' );
print $something, "\n";
$something->frobnicate;
my $something_else = My::Class->new( foo => 'baz' );
print $something_else, "\n";
$something_else->frobnicate;
Gives:
Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x2fd5a10)
Frobnicated!
My::Class=HASH(0x2fd2c08)
Can't locate object method "frobnicate" via package "My::Class" at testmoose.pl line 32.
use AUTOLOAD to define the function. As a example method foo is called if $self->{foo} exists
sub AUTOLOAD {
my $methodname = $AUTOLOAD;
if ($methodname eq "foo" && exists($_[0]->{foo})){
goto &fooimplementationsub;
}
return;
}
An alternative technique is to use globs to define a new method at runtime
*PACKAGE::method = sub {
#code here
};
This has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
A third and possibly more risky/inefficient method is to use string eval
eval <<EOF
sub foo {
#code here
};
EOF
Again this has the disadvantage that the method is now visible to all instances of the class so is not quite what you want.
Methods are just subroutines in a package, and a package is just a hash holding typeglobs. And hashes can be modified at runtime.
So you could, in theory, add or remove methods given values in a constructor.
package WeirdClass;
sub new {
my ($class, $name, $code) = #_;
if ($name) {
no strict;
*{__PACKAGE__ . "::$name"} = $code;
}
bless {} => $class;
}
And then use it like:
my $object = WeirdClass->new(foo => sub {say "foo"});
$object->foo(); # prints "foo\n";
However, this method is available for all objects of that class:
my $another_object = WeirdClass->new();
$another_object->foo; # works too.
Using autoload, one can mock arbitrary methods:
package BetterClass;
sub new {
my ($class, %args) = #_;
bless \%args => $class;
}
# destructor will be called at cleanup, catch with empty implementation
sub DESTROY {};
sub AUTOLOAD {
my $self = shift;
(my $method = our $AUTOLOAD) =~ s/.*://; # $AUTOLOAD is like "BetterClass::foo"
# check if method is allowed
die "forbidden method $method" unless $self->{can}{$method};
# mock implementations
given ($method) {
say "foo" when "foo";
say "bar" when "bar";
when ("add") {
my ($x, $y) = #_;
return $x + $y;
}
default { die "unknown method $method" }
}
}
Then:
my $o = BetterClass->new(can => { foo => 1, bar => 0});
$o->foo;
my $p = BetterClass->new(can => {bar => 1, add => 1});
$p->bar;
say $p->add(5, 6);
Of course, these techniques can be combined freely.
Edit: can()
To make the AUTOLOAD work with can, the protected methods should be moved into a data structure:
my %methods;
BEGIN {
%methods = (
foo => sub {say "foo"},
bar => sub {say "bar"},
add => sub {
my ($self, $x, $y) = #_;
$x + $y;
},
);
}
Then override the can method:
# save a reference to the origional `can` before we override
my $orig_can;
BEGIN{ $orig_can = __PACKAGE__->can("can") }
sub can {
my ($self, $meth) = #_;
# check if we have a special method
my $code = $methods{$meth} if ref $self and $self->{can}{$meth};
return $code if $code;
# check if we have a normal method
return $self->$orig_can($meth);
}
And AUTOLOAD would change to
my ($self) = #_; # do not `shift`
(my $method = our $AUTOLOAD) =~ s/.*://;
my $code = $self->can($method) or die "unknown method $method";
goto &$code; # special goto. This is a AUTOLOAD idiom, and avoids extra call stack frames
Don't do too much magic. I've gotten away from AUTOLOAD because it causes maintenance issues where mysterious methods suddenly appear and disappear.
One way to handle what you want is to define all the methods you need, and if a particular object is of the wrong type, simply cause that method to croak:
sub Foo {
my $self = shift;
my $parameter = shift;
if ( $self->Class_type ne "Foo" ) {
croak qq(Invalid method 'Foo' on object #{[ref $self]});
}
print "here be dragons\";
return "Method 'Foo' successfully called";
}
The above will not allow method Foo to be called unless the class type is Foo.
If your objects won't change (or you don't want them to change) once an object is created, you can define that object as a sub-class.
Before you bless a newly created object, check that special value and decide whether or not you need to create a specific sub-class instead.
package My_class;
sub new {
my $class = shift;
my $class_type = shift;
my $self = shift;
if ( $class_type eq "Foo" ) {
bless $self, "My_class::Foo";
}
else {
bless $self, $class;
}
package My_class::Foo;
use base qw(My_class);
sub Foo {
my $self = shift;
return "Foo Method successfully called!";
}
Notice that my class My_class::Foo is a sub-class of My_class via the use base pragma. That means all methods for My_class are valid with objects of My_class::Foo. However, only objects of My_class::Foo can call the Foo method.
When I create my object (via the new subroutine), I look at the $class_type parameter. If it's a type Foo, I bless the class as My_class::Foo.
Here's an example where I use sub-classes to do what you want.
Every object is a class type of Question. You can see my constructor on line 1129. I pass in a question type as one of the parameters to my constructor.
In line 1174 to 1176, I create my object, but then append the question type to the class, and then bless the question as that sub-class type. All of my subclasses are a type Question (see my use base qw(Question); below each package declaration. However, only questions of sub-class Question::Date and Question::Regex have a method Format. And, only objects of type Question::Words have a method Force.
Hope this helps.
None of the answers so far given actually handle the question actually asked.
Adding methods to an instance in Perl is not directly supported. Object instances are always instances of some class, and that class is the thing that actually has methods. You cannot add a method to a single instance of a class, without making that method also available on every other instance of the same class.
For your problem you have two basic solutions:
Provide the methods always, but test a flag to see whether the method should apply to the given instance or not. This is by far the simplest.
Bless each object into subclasses depending on the flags. Subclass the main class to provide those methods as appropriate.
If you truely want to add methods on individual instances, then what you'll have to do is arrange that every instance is a single instance of a newly-derived class for every object. This gets harder to arrange for, doubly-so if you want to avoid leaking memory and cleaning up the classes once the objects are DESTROYed. This would however allow truely per-instance methods.
Since it is highly unlikely you'll truely need this third option it is far better to go with one of the first.

How to access object features in Perl from within the same package

I'm making a Perl module and I am still getting to grips with how Perl deals with objects.
This is the new sub that I wrote to create an object and I have no problem updating elements:
sub new {
my $class = shift;
my ($self) = {
name => undef
};
bless($self, $class);
return $self;
}
sub get_name {
my $self = shift;
$self->{name} = 'Eve';
return $self->{name};
}
I can use the object fine when I call the module and access it from another file, but I want to use the data in the object at other areas in the module code.
So I have no problem doing this:
my $new_object = new ProgramTest; # ProgramTest being the module/package
my $name = get_name();
But I want to use the $self elements in a 'module-internal' method which is never accessed by an outside script. So I want to have something like this:
sub get_variables {
return (name); # I don't know how to get the name here
# (I plan to have other variables, too)
}
I am probably missing something obvious (I'm sure I'll kick myself when I see the solution), so any help appreciated!
I want this so that the rest of the module can use the variables (without changing) as there are conditions that rely on their values.
There's no such thing as internal/private methods in perl objects. Common practise is to start any methods which should not be used publicly with an underscore, but this is not enforced in any way. Also have a look at moose - it takes a lot of the hassle out of OO perl.
With regards to your question the below shows how one module method can call another module method, with both having access to the object data. Again I woulds really recommend you use Moose!
sub publicSub{
my ( $self ) = #_;
return $self->_privateSub();
}
sub _privateSub{
my ( $self ) = #_;
return $self->{name};
}
I think you want class-variables. They are global to a class and all instances of the class (i.e. all the objects you created) can see them. Global in this case means that they are at the ouside-most lexical scope, so all subs can see them.
package ProgramTest;
my $everyone_can_see_this = 1; # lexical scope, but 'global' to the package
sub new {
my $class = shift;
my ($self) = {
name => undef
};
bless($self, $class);
return $self;
}
sub get_var {
my $self = shift;
return ++$everyone_can_see_this;
}
package Main;
my $o1 = ProgramTest->new;
my $o2 = ProgramTest->new;
say $o1->get_var;
say $o2->get_var;
say $o1->get_var;
__END__
2
3
4
But I don't see why you would want to do that. It doesn't make sense (unless you want an object-counter). Don't use it for config values, or you cannot really have objects for different purposes of the same class.
Maybe you want something else. If so, please try to rephrase your question.

How to make "universal" getters and setters in an object in perl?

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.

How can I call methods on a tied variable?

I've just started to learn about tie. I have a class named Link which I would like to do the following thing:
if fetched, return the link's address
if stored, store the new address
be able to call methods on it
So far, my code is :
package Link;
sub FETCH {
my $this = shift;
return $this->{"site"};
}
sub STORE {
my ($self,$site) = #_;
$self->{"site"} = $site;
}
sub print_method {
my $self = shift;
print $self->{"site"};
}
sub TIESCALAR {
my $class = shift;
my $link = shift;
my $this = {};
bless($this,$class);
$this->{"site"} = $link;
return $this;
}
1;
And the code I'm using to check the functionality is:
use Link;
tie my $var,"Link","http://somesite.com";
$var->print_method;
When ran, the script will terminate with the following error:
Can't call method "print_method" without a package or object reference at tietest.pl line 4..
If I understand its message correctly, $var->print_method resolves to some string upon which the method print_method is called. How could I benefit from tie, but also use the variable as an object?
EDIT: after experimenting a bit,I found out that if I return $self on fetch , I can call the methods , however , fetch won't return the address .
EDIT 2:the perl monks supplied me the solution : tied . tied will return a reference to the object VARIABLE .
By combining tied with my methods , I can accomplish everything I wanted .
Tie is the wrong tool for this job. You use ties when you want the same interface as normal data types but want to customize how the operations do their work. Since you want to access and store a string just like a scalar already does, tie doesn't do anything for you.
It looks like you want the URI module, or a subclass of it, and perhaps some overloading.
If you really need to do this, you need to use the right variable. The tie hooks up the variable you specify to the class you specify, but it's still a normal scalar (and not a reference). You have to use the object it returns if you want to call methods:
my $secret_object = tie my($normal_scalar), 'Tie::Class', #args;
$secret_object->print_method;
You can also get the secret object if you only have the tied scalar:
my $secret_object = tied $normal_scalar;
I have an entire chapter on tie in Mastering Perl.
I suggest making a normal Perl object and then overloading stringification. You lose the ability to store a value through assignment, but retain the ability to get the value out by printing the object. Once you start wanting to call methods directly, an object is probably what you want.
package Link;
use strict;
use Carp;
use overload
(
'""' => sub { shift->site },
fallback => 1,
);
sub new
{
my $class = shift;
my $self = bless {}, $class;
if(#_)
{
if(#_ == 1)
{
$self->{'site'} = shift;
}
else { croak "$class->new() expects a single URL argument" }
}
return $self;
}
sub site
{
my $self = shift;
$self->{'site'} = shift if(#_);
return $self->{'site'};
}
sub print_method
{
my $self = shift;
print $self->site, "\n";
}
1;
Example usage:
use Link;
my $link = Link->new('http://somesite.com');
print $link, "\n"; # http://somesite.com
$link->print_method; # http://somesite.com
If you really, really want assignment to work too, you can combine a normal object with overloaded stringification (Link, above) with tie:
package LinkTie;
use strict;
use Link;
sub FETCH
{
my $this = shift;
return $this->{'link'};
}
sub STORE
{
my($self, $site) = #_;
$self->{'link'}->site($site);
return $site;
}
# XXX: You could generalize this delegation with Class::Delegation or similar
sub print_method
{
my $self = shift;
print $self->{'link'}->print_method;
}
sub TIESCALAR
{
my $class = shift;
my $self = bless {}, $class;
$self->{'link'} = Link->new(#_);
return $self;
}
1;
Example usage:
tie my $link,'LinkTie','http://somesite.com';
print $link, "\n"; # http://somesite.com
$link->print_method; # http://somesite.com
$link = 'http://othersite.com';
print $link, "\n"; # http://othersite.com
$link->print_method; # http://othersite.com
This is all quite hideous and a long way to go just to get the dubious ability to assign to something that you can also call methods on and also print as-is. A standard URI object with stringification is probably a better bet.