nysus has asked for the wisdom of the Perl Monks concerning the following question:

I've been reading Conway's OO Perl. He offers pseudo-hashes as a solution to the problem of autovivification of object entries that don't exist. Now pseudo-hashes don't enjoy the best reputation and they'll be gone come Perl 6. As an alternate solution I came up with this simple bit of code which I placed in the constructor of Conway's 3.4 code listing beginning on page 114: 
if (%arg) {                                    #performed only if obj.
+ arguments given
        my %_temp_hash = _return_attr_data();            #returns list
+ of obj. attributes
        foreach my $argcheck (keys %arg) {                
            next if exists $_temp_hash{"_" . $argcheck};    #checks if
+ attribute exists
            croak "An invalid CD attribute given";        #if not, cro
+aks with error
        }
    }

[download]
So what's wrong with this as a solution to prevent the autovivification of an object attribute? Is there a reason why something like this isn't offerred as a solution in Conway's book? To view the above code in its complete context with my additions in bold... 
package Music;
$VERSION = 1.00;
use strict;
use vars qw( $AUTOLOAD );
use Carp;

{
# Encapsulated class data

    my %_attr_data = #        DEFAULT                ACCESSIBILITY
        ( _name         => [ '???',                'read'],
          _artist        => [ '???',                'read'],
          _publisher    => [ '???',                'read'],
          _ISBN        => [ '???',                'read'],
          _tracks        => [ '???',                'read'],
          _rating        => [ -1,                'read/write'],
          _room        => [ 'uncatalogued',    'read/write'],
          _shelf         => [ "",                'read/write'],
        );
    my $_count = 0;
# Class methods, to operate on encapsulated class data
    
    # Is a specified object attribute accessible in a given mode
    sub _accessible {
        my ($self, $attr, $mode) = @_;
        $_attr_data{$attr}[1] =~ /$mode/
    }
    
    # Classwide default value for a specified object attribute
    sub _default_for {
        my ($self, $attr) = @_;
        $_attr_data{$attr}[0];
    }
    
    # List of names of all specified object attributes
    sub _standard_keys {
        keys %_attr_data;
    }

[download]
    sub _return_attr_data {
        %_attr_data;
    }

[download]
    
    # Retrieve object count
    sub get_count {
        $_count;
    }
    
    # Private count increment/decrement methods
    sub _incr_count { ++$_count }
    sub _decr_count { --$_count }

}

# Constructor may be called as a class method
# (in which case it uses the calss's default values),
# or an object method
# (in which case it gets defaults from the existing object)

sub new
{
    my ($caller, %arg) = @_;
    my $caller_is_obj = ref($caller);
    my $class = $caller_is_obj || $caller;
    my $self = bless {}, $class;

[download]
    if (%arg) {
        my %_temp_hash = _return_attr_data();
        foreach my $argcheck (keys %arg) {
            next if exists $_temp_hash{"_" . $argcheck};
            croak "An invalid CD attribute given";
        }
    }

[download]
        
    foreach my $attrname ( $self->_standard_keys() ) {
        my ($argname) = ($attrname =~ /^_(.*)/);
        if (exists $arg{$argname})
            { $self->{$attrname} = $arg{$argname} }
        elsif ($caller_is_obj)
            { $self->{$attrname} = $caller->{$attrname} }
        else { $self->{$attrname} = $self->_default_for($attrname) }
    }
    $self->_incr_count();
    return $self;
}

# Destructor adjusts class count
sub DESTROY
{
    $_[0]->_decr_count();
}

# get or set room&shelf together

sub get_location { ($_[0]->get_room(), $_[0]->get_shelf()) }
sub set_location {
    my ($self, $room, $shelf) = @_;
    $self->set_room($room) if $room;
    $self->set_shelf($shelf) if $shelf;
    return;
}

# Implement other get_... and set_... methods (create as necessary)

sub AUTOLOAD {
    no strict "refs";
    my ($self, $newval) = @_;
    
    # Was it a get_... method?
    if ($AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1, 'read')
+) {
        my $attr_name = $1;
        *{$AUTOLOAD} = sub { return $_[0]->{$attr_name} };
        return $self->{$attr_name};
    }
    
    # Was it a set_... method?
    if ($AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1, 'write'
+)) {
        my $attr_name = $1;
        *{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return };
        $self->{$1} = $newval;
        return;
    }
    
    # Must have been a mistake then...
    croak "No such method: $AUTOLOAD";
}

1; # Ensure that the module can be succesfully use'd

[download]

$PM = "Perl Monk's";
$MCF = "Most Clueless Friar Abbot Bishop";
$nysus = $PM . $MCF;
Click here if you love Perl Monks

Edit: chipmunk 2001-007-15

Replies are listed 'Best First'.
Re: Preventing autovivification of object attributes
by japhy (Canon) on Jul 15, 2001 at 22:26 UTC
    I'm not sure I see why your code is needed. It appears that the assignment of attributes is done on a "only assign attributes that have been noted as existing."

    To paracode, I mean: 

    sub new {
  # ...
  for (@valid_keys) {
    if (exists $arg{$_}) { $self->{$_} = $arg{$_} }
  }
}

    [download]
    is being done already. There doesn't appear to be a need to put a layer on top of that.

    _____________________________________________________
    Jeff japhy Pinyan: Perl, regex, and perl hacker.
    s++=END;++y(;-Q)}y js++=;shajsj<++y(p-q)}?print:??;
[reply]
[d/l]
      Well, when I run Conway's code without my additions, the line below with a misspelled attribute in it, "arist", lets the object be blessed by the constructor with no problem. 
      my $cd = Music->new(name => 'Four Seasons', arist => 'Vivaldi', rating
+ => 7,);

      [download]
      With my code, I at least get an error. So it looks like an improvement but not in the way I thought.

      Looking again at his code, I see you are correct: if the argument given doesn't exist as an attribute, it is getting ignored rather than autovivified as I mistakenly assumed. What confused me I didn't read close enough is Conway's second paragraph of page 119: 

      If you have a reference to a hash-based object, say, $objref, and you'
+re using an attribute such as $objref->{_weirdness_factor}, then chan
+ces are that somewhere in the heat of coding, you'll accidentally wri
+te something like $objref->{_wierdness_factor}++.

      [download]
      I'm beginning to think he is talking about autovivification that occurs from code located within the class like what happens on page 129 with his Transceiver class and not autovivication during object construction. Am I right on this? Thanks for the help.

      $PM = "Perl Monk's";
      $MCF = "Most Clueless Friar Abbot Bishop";
      $nysus = $PM . $MCF;
      Click here if you love Perl Monks

[reply]
[d/l]
[select]
        Yep, no problem. I see where you were coming from now.

        _____________________________________________________
        Jeff japhy Pinyan: Perl, regex, and perl hacker.
        s++=END;++y(;-Q)}y js++=;shajsj<++y(p-q)}?print:??;
[reply]
Re: Preventing autovivification of object attributes
by bikeNomad (Priest) on Jul 16, 2001 at 00:49 UTC
    Perhaps a better solution to this problem is to tie the hash to an object that can maintain a read-only or read-write policy:

    use strict;
use Tie::Hash;
use Carp;

package AccessControl;
@AccessControl::ISA = 'Tie::StdHash';

sub allowVivification { $_[0]->{__novivify} = not $_[1] }

sub TIEHASH { bless { __novivify => 0 }, $_[0] }

sub STORE
{
 my ( $self, $key, $value ) = @_;
 if ( $self->{__novivify} )
 {
  unless ( exists( $self->{$key} ) )
  {
   Carp::carp("Autovivification of key $key not allowed");
   return;
  }
 }
 $self->{$key} = $value;
}

sub FIRSTKEY
{
 my $a   = scalar keys %{ $_[0] }; # reset each iterator
 my $key = each %{ $_[0] };
 $key eq '__novivify' ? each %{ $_[0] } : $key;
}

sub NEXTKEY
{
 my $key = each %{ $_[0] };
 $key eq '__novivify' ? each %{ $_[0] } : $key;
}

package main;

my %hash;
my $accessControl = tie %hash, 'AccessControl';

$hash{abc} = 'def';    # OK
$accessControl->allowVivification(0);
$hash{ghi} = 'xxx';    # carps
$accessControl->allowVivification(1);
$hash{jkl} = 'yyy';    # OK
print join ( ' ', keys(%hash) ), "\n";   # abc jkl

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom