Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Hash::AsObj

by runrig (Abbot)
on Apr 06, 2004 at 17:51 UTC ( #343041=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info /msg runrig
Description: An experiment in AUTOLOAD and lvalue subs which resulted in a sort of combination of Hash::AsObject and Tie::SecureHash (update: actually more simply like Tie::Hash::FixedKeys or Hash::Util::lockkeys). The hash is 'secure' as long as you only access it as an object using methods, but you are free to add keys when directly accessing it as a hash ref. In the interest of keeping it simple, I'm not going to worry about handling keys like 'isa', 'can', 'AUTOLOAD', 'DESTROY', or '*::*'. And this definitely breaks can().

Updated/fixed code so that lvalue methods work better.(see reply node)

#!/usr/bin/perl

package Hash::AsObj;

my %sub_class;

sub new {
  my $class = shift;
  my $href = { @_ };
  my $sub_class;
  # Keep hashes with the same set of keys in
  # the same package
  my $class_key = join "~", sort keys %$href;
  if ( exists $sub_class{$class_key} ) {
    $sub_class = $sub_class{$class_key};
  } else {
   ( $sub_class = "$href" ) =~ tr/()/__/;
   $sub_class{$class_key} = $sub_class;
  }
  @{"${class}::Data::${sub_class}::ISA"} = "Hash::AsObj::Data";
  bless $href, "${class}::Data::$sub_class";
}

package Hash::AsObj::Data;
use Carp ();

sub DESTROY { 1 }

sub AUTOLOAD : lvalue {
  my ( $class, $method ) = $AUTOLOAD =~ /^(.*)::(.+)$/
    or Carp::croak "Invalid call to $AUTOLOAD";
  Carp::croak "Can't locate object method $method via package $class"
    unless exists $_[0]->{$method};
  *$AUTOLOAD = sub : lvalue {
    my $self = shift;
    if (@_) {
      $self->{$method} = shift;
      return $self;
    }
    $self->{$method};
  };
  goto &$AUTOLOAD;
  $Hash::AsObj::foo;
}

package main;
use strict;
use warnings;

my $hobj = Hash::AsObj->new( a=>1, b=>2, c=>3 ,e=>5 );
print $hobj->a, "\n";
# It's an lvalue method!
$hobj->a++;
print $hobj->a, "\n";
# Or supply an argument to set values
# I like method chaining - Your opinion may differ
$hobj
  ->b(5)
  ->c(6);
print "b: ", $hobj->b, " c:", $hobj->c, "\n";
# Error - this key doesn't exist
print $hobj->d;

Comment on Hash::AsObj
Download Code
Re: Hash::AsObj
by runrig (Abbot) on Jun 02, 2004 at 18:25 UTC
    I never noticed before that in order to use the method as an lvalue, you had to use it as an rvalue first to define the function. But you can define AUTOLOAD as an lvalue method, and then it almost works, as the following code demonstrates:
    #!/usr/bin/perl package Foo; sub new { bless {}, shift } sub DESTROY {1} sub AUTOLOAD : lvalue { my ( $method ) = $AUTOLOAD =~ /^.*::(.+)$/ or die "Invalid call to $AUTOLOAD"; *$AUTOLOAD = sub : lvalue { my $self = shift; if (@_) { $self->{$method} = shift; return $self; } $self->{$method}; }; goto &$AUTOLOAD; # Uncomment the following 'useless' line # and it works: # $Foo::baz; } package main; my $foo = Foo->new; $foo->bar = 4; print $foo->bar,"\n";
    With the above code you get this error:
    Can't modify goto in lvalue subroutine return at ...
    If you uncomment the last line of the AUTOLOAD, you seem to fool the compiler into thinking that AUTOLOAD is going to return a valid lvalue, even though it never actually returns that value, since you goto somewhere else first.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://343041]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2014-12-18 03:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (41 votes), past polls