Being more restrictive when using blessed hash ref for OOP

[A. Farber]

Hello,

I define and use several classes in my Perl application,
and I use blessed hash refs to store the data members.

Often I wonder, if there is a possibility for being
more restrictive - for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

Any suggestions please? Example of my code below...

Regards
Alex


package Game;
use strict;

our (%Games, $Num, $Sth_create_topic, $Sth_create_reply);

sub new {
my $pkg = shift;
my @chars = ('a'..'z', 'A'..'Z');

my $game = {
GID => ++$Num,
PHASE => CHATTING,
PLAYERS => [ ],
KIBITZERS => [ ],
INFO => undef,
DECK => [ 0 .. 31 ],
TABLE => undef,
NTABLE => undef,
START => undef,
TURN => undef,
NPASSED => undef,
HOLDER => undef,
WHISTER1 => undef,
WHISTER2 => undef,
ACTIVE => undef,
PASSIVE => undef,
SHOW => undef,
LATER => undef,
BEFORE => undef,
TRUMP => undef,
SUIT1 => undef,
TOPIC => undef,
WINNER => undef,
ROUND => 0,
BBCODE => '',
SUBJ => '',
BODY => '',
};

# generate 8 random characters used for posts in phpBB
$game->{BBCODE} .= $chars[rand @chars] while length $game->
{BBCODE} < 8;

$Games{$Num} = $game;
bless($game, $pkg);
}

# +500 more lines

 

[Peter Makholm]

Often I wonder, if there is a possibility for being
more restrictive - for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

One solution could be to use the lock_keys functionality from
Hash::Util.

Even better would be to make methods for accessing you
attributes. Then you don't have to access the hash directly except for
a few well defined places. There are modules which makes these
accessor methods for youeasily, for example Class::Accessor.

And even better could be to use a full blown object system like
Moose.

//Makholm

 

[A. Farber]

Thanks.

I'd wished Class::Struct would use
Hash::Util::lock_keys - that would
be exactly what I need: define which
data memebers (and of what type)
are there in the constructor
and then don't allow anything else.

Sometimes I think of rewriting
my app in C++ because its compiler
would provide me that

Regards
Alex

 

[sln]

Hello,

I define and use several classes in my Perl application,
and I use blessed hash refs to store the data members.

Often I wonder, if there is a possibility for being
more restrictive - for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

Any suggestions please? Example of my code below...

Regards
Alex

Blessing an array reference instead will give you a bareword error if the wrong constant is used
when acessing it (as in the blow code). Still has the same form though: $g->[] instead of $g->{}

Anyway, something to think about.

-sln

----------------------------
## gtest1.pl
##
use strict;
use warnings;

use Game;

my @Grefs = ();

# start 11 games
Game->new() for (1 .. 11);

for my $key (sort {$a <=> $b} keys %Game::Games)
{
my $g = $Game::Games{$key};

printf "\nGame #: %d\n------------------------\n", $$g[GID];
printf " (%2d) phase - %s\n", PHASE, $$g[ PHASE ];
printf " (%2d) players - %s\n", PLAYERS, join ' ', @{$$g[ PLAYERS ]};
printf " (%2d) deck - %s\n", DECK, join ' ', @{$$g[ DECK ]}[0..10]; # just print out 10 elements
printf " (%2d) bbcode - %s\n", BBCODE, $$g[ BBCODE ];

$g->test();
print " $g->[HVARS]{misc_1}\n";
print " $g->[HVARS]{misc_2}\n";
}

print "\n\nTotal current games: $Game::Num\n\n";

-------------------------------------------------------------------
# or ...

## gtest2.pl
##
use strict;
use warnings;

use Game;

my @Grefs = ();

# start 5 games

for (1 .. 5)
{
my $g = Game->new();
push @Grefs, $g;

printf "\nCreating game #: %d\n------------------------\n", $$g[GID];
printf " (%2d) phase - %s\n", PHASE, $$g[ PHASE ];
printf " (%2d) players - %s\n", PLAYERS, join ' ', @{$$g[ PLAYERS ]};
printf " (%2d) deck - %s\n", DECK, join ' ', @{$$g[ DECK ]}[0..10]; # just print out 10 elements
printf " (%2d) bbcode - %s\n", BBCODE, $$g[ BBCODE ];

$g->test();
}

print "\n\nTotal current games: $Game::Num\n\n";


----------------------------
## Game.pm
##

package Game;

use strict;
use warnings;

use Exporter qw( import );
our @ISA = qw();

# Export any bareword constants needed by caller
# (be carefull of caller namespace pollution)
our @EXPORT = qw( GID PHASE PLAYERS DECK BBCODE HVARS );

our (%Games, $Num, $Sth_create_topic, $Sth_create_reply);

use constant {
GID => 0,
PHASE => 1,
PLAYERS => 2,
KIBITZERS => 3,
INFO => 4,
DECK => 5,
TABLE => 6,
NTABLE => 7,
START => 8,
TURN => 9,
NPASSED => 10,
HOLDER => 11,
WHISTER1 => 12,
WHISTER2 => 13,
ACTIVE => 14,
PASSIVE => 15,
SHOW => 16,
LATER => 17,
BEFORE => 18,
TRUMP => 19,
SUIT1 => 20,
TOPIC => 21,
WINNER => 22,
ROUND => 23,
BBCODE => 24,
SUBJ => 25,
BODY => 26,
HVARS => 27
};


sub new {
my $pkg = shift;
my @chars = ('a'..'z', 'A'..'Z');

my @game = ();

$game[ GID ] = ++$Num;
$game[ PHASE ] = 'CHATTING';
$game[ PLAYERS ] = [];
$game[ KIBITZERS ] = [];
$game[ INFO ] = undef;
$game[ DECK ] = [ 0 .. 31 ];
$game[ TABLE ] = undef;
$game[ NTABLE ] = undef;
$game[ START ] = undef;
$game[ TURN ] = undef;
$game[ NPASSED ] = undef;
$game[ HOLDER ] = undef;
$game[ WHISTER1 ] = undef;
$game[ WHISTER2 ] = undef;
$game[ ACTIVE ] = undef;
$game[ PASSIVE ] = undef;
$game[ SHOW ] = undef;
$game[ LATER ] = undef;
$game[ BEFORE ] = undef;
$game[ TRUMP ] = undef;
$game[ SUIT1 ] = undef;
$game[ TOPIC ] = undef;
$game[ WINNER ] = undef;
$game[ ROUND ] = 0;
$game[ BBCODE ] = '';
$game[ SUBJ ] = '';
$game[ BODY ] = '';
$game[ HVARS ] = ();

# generate 8 random characters used for posts in phpBB
$game[ BBCODE ] .= $chars[rand @chars] while length $game [ BBCODE ] < 8;

# add ficticous players
my @players = qw( Fred Jane Sam Karen Jill George Ed Mary Cathy Bill);
my %hseen;
while ( @{$game[ PLAYERS ]} < 4 ) {
my $rval = int rand( 10 );
if (++$hseen{ $rval } == 1) {
push @{$game[ PLAYERS ]}, $players[ $rval ];
}
}

# add some hvars
$game[ HVARS ]{misc_1} = 'Misc hvar1';
$game[ HVARS ]{misc_2} = 'Misc hvar2';

$Games{$Num} = \@game;
bless(\@game, $pkg);
}

sub test {
my $self = shift;
print " Game::test -> this is game number $self->[GID]\n";
}


1;

__END__

output:

Game #: 1
------------------------
( 1) phase - CHATTING
( 2) players - Jill Jane Karen Mary
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - uliextQX
Game::test -> this is game number 1
Misc hvar1
Misc hvar2

Game #: 2
------------------------
( 1) phase - CHATTING
( 2) players - Cathy Ed Sam George
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - RjDVIJfS
Game::test -> this is game number 2
Misc hvar1
Misc hvar2

Game #: 3
------------------------
( 1) phase - CHATTING
( 2) players - Cathy Mary Ed Sam
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - FuCekHEK
Game::test -> this is game number 3
Misc hvar1
Misc hvar2

Game #: 4
------------------------
( 1) phase - CHATTING
( 2) players - Fred Ed George Mary
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - TDrZeoFg
Game::test -> this is game number 4
Misc hvar1
Misc hvar2

Game #: 5
------------------------
( 1) phase - CHATTING
( 2) players - George Mary Karen Ed
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - SFRQSpwb
Game::test -> this is game number 5
Misc hvar1
Misc hvar2

Game #: 6
------------------------
( 1) phase - CHATTING
( 2) players - George Ed Sam Jane
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - ciOaDodl
Game::test -> this is game number 6
Misc hvar1
Misc hvar2

Game #: 7
------------------------
( 1) phase - CHATTING
( 2) players - Ed Bill George Mary
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - IkwvnETT
Game::test -> this is game number 7
Misc hvar1
Misc hvar2

Game #: 8
------------------------
( 1) phase - CHATTING
( 2) players - Ed Fred George Bill
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - jYpluPkl
Game::test -> this is game number 8
Misc hvar1
Misc hvar2

Game #: 9
------------------------
( 1) phase - CHATTING
( 2) players - Karen Sam Mary Fred
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - MgWhsqVw
Game::test -> this is game number 9
Misc hvar1
Misc hvar2

Game #: 10
------------------------
( 1) phase - CHATTING
( 2) players - Jill George Sam Karen
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - ukpyRwfX
Game::test -> this is game number 10
Misc hvar1
Misc hvar2

Game #: 11
------------------------
( 1) phase - CHATTING
( 2) players - Ed Jill Karen Sam
( 5) deck - 0 1 2 3 4 5 6 7 8 9 10
(24) bbcode - NbCTbivT
Game::test -> this is game number 11
Misc hvar1
Misc hvar2


Total current games: 11

 

[sln]

Hello,

I define and use several classes in my Perl application,
and I use blessed hash refs to store the data members.

Often I wonder, if there is a possibility for being
more restrictive - for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

Any suggestions please? Example of my code below...

Regards
Alex

Blessing an array reference instead will give you a bareword error if the wrong constant is used
when acessing it (as in the blow code). Still has the same form though: $g->[] instead of $g->{}

Anyway, something to think about.

my @game = ();

Using constants you would never have to declare unambigous elements,
so this initialization could be reduced to:

$game[ GID ] = ++$Num;
$game[ PHASE ] = 'CHATTING';
$game[ PLAYERS ] = [];
$game[ KIBITZERS ] = [];
$game[ DECK ] = [ 0 .. 31 ];
$game[ ROUND ] = 0;
$game[ BBCODE ] = '';
$game[ SUBJ ] = '';
$game[ BODY ] = '';
$game[ HVARS ] = ();


Of course this wont provide locking, but it obscures the array index and
forces the user or within the module to use named constants as indexes,
whose values can change without need to change user code.

User harcoded numeric index's could break in future pm versions and is not
reliable.

-sln

 

[A. Farber]

Blessing an array reference instead will give you a bareword error if the wrong constant is used
when acessing it (as in the blow code). Still has the same form though:  $g->[] instead of $g->{}

Thank you for the idea!

 

[Skye Shaw!@#$]

Hello,

I define and use several classes in my Perl application
and I use blessed hash refs to store the data members.

Often I wonder, if there is a possibility for being
more restrictive

Yes, a strongly statically typed language.

for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

As someone has pointed out, these should be accessors, but I wonder,
what is you primary concern?
Someone misusing your package, coding errors, or both?

 

[jl_post]

I define and use several classes in my Perl application,
and I use blessed hash refs to store the data members.

Often I wonder, if there is a possibility for being
more restrictive - for example I'd prefer to get
a warning, when I reference or vivificate a
$href->{PLAYER} instead of $href->{PLAYERS} by mistake

Any suggestions please?

You might want to take a look at the "fields" module. (Read about
it with "perldoc fields".)

It's been years since I last used it (so my memory on it is a bit
sketchy), but it'll allow you to do things like:

#/usr/bin/perl
package Game;
use strict;
use warnings;
use fields qw(PLAYERS);
sub new
{
my Game $self = shift;
$self = fields::new($self) unless (ref $self);
return $self;
}
my $href = Game->new;
$href->{PLAYERS} = []; # acceptable
$href->{PLAYER} = []; # generates an error
__END__

When I try to run this script, I get:

Attempt to access disallowed key 'PLAYER' in a restricted hash at -
line 14.

I THOUGHT barewords would be checked at compile-time, but my own
experimentation just now leads me to believe it's a run-time check.
Either way, that's better than nothing.

I hope this helps.

-- Jean-Luc

 

[sln]

You might want to take a look at the "fields" module. (Read about
it with "perldoc fields".)

It's been years since I last used it (so my memory on it is a bit
sketchy), but it'll allow you to do things like:

#/usr/bin/perl
package Game;
use strict;
use warnings;
use fields qw(PLAYERS);
sub new
{
my Game $self = shift;

^^^^^^^^^^^^^^^^^^^^^
I'm not from oldschool. What syntax is this?

$self = fields::new($self) unless (ref $self);

^^^.........
Can you explain this briefly. No use putting down stuff somebody
has to explore. Where is the bless?

return $self;
}
my $href = Game->new;
$href->{PLAYERS} = []; # acceptable
$href->{PLAYER} = []; # generates an error

^^^^^^^^^^^^^^^^^
Well that would double/tripple execution speed wouldn't it?
Looks like overloaded '->' if this were C++ and '->' were an operator.

__END__

When I try to run this script, I get:

Attempt to access disallowed key 'PLAYER' in a restricted hash at -
line 14.

I THOUGHT barewords would be checked at compile-time, but my own
experimentation just now leads me to believe it's a run-time check.

How did you draw that conclusion? Why wouldn't barewords be compile-time?

Either way, that's better than nothing.

I hope this helps.

-- Jean-Luc

-sln

 

[jl_post]

     ^^^^^^^^^^^^^^^^^^^^^
I'm not from oldschool. What syntax is this?

I actually got this code (with modifications so that it fits the
"Game" package) from the "perldoc fields" documentation. You can read
about it there.

     ^^^.........
Can you explain this briefly. No use putting down stuff somebody
has to explore. Where is the bless?

Again, I got this code from the "perldoc fields" documentation. As
for where is the bless, that's a good questions. I know the "perldoc
fields" documentation covers that (it's not hard to find; just search
for "bless").

How did you draw that conclusion? Why wouldn't barewords be compile-time?

I drew that conclusion by placing output statements before the line
that caused the error. Since those lines were run before the error
message was shown, I concluded that part of the program was run, and
therefore the error was caught at run-time. (Although it would be
nice if bareword errors of that type were caught at compile-time.)

If you find the code confusing, or there's something about it you
don't understand, I highly recommend reading perldocs on
"field" (that's what they're there for, after all). Otherwise, I'd
just be stating what you already have access to.

Cheers,

-- Jean-Luc