Standard simple way to tie
Brian McCauley
can create one-off tied variables without the hassle of creating a
class for each.
package Tie::Simple;
sub AUTOLOAD {
my $self = shift;
# All class methods are the contstuctor
return bless { @_ }, $self unless ref $self;
my $code = $self->{(our $AUTOLOAD =~ /(\w+)$/)[0]};
goto &$code if $code;
}
1;
__END__
I find it hard to belive that nothing of this sort exists in the
standard modules let alone CPAN.
Am I missing something really obvious?
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
Benjamin Goldberg
>
> I keep finding myself wanting a module like the following so that I
> can create one-off tied variables without the hassle of creating a
> class for each.
>
> package Tie::Simple;
>
> sub AUTOLOAD {
> my $self = shift;
> # All class methods are the contstuctor
> return bless { @_ }, $self unless ref $self;
> my $code = $self->{(our $AUTOLOAD =~ /(\w+)$/)[0]};
> goto &$code if $code;
> }
>
> 1;
>
> __END__
>
> I find it hard to belive that nothing of this sort exists in the
> standard modules let alone CPAN.
>
> Am I missing something really obvious?
I don't think so. Consider the Tie::Restore module, which is quite
useful if you need to untie an object, do something with it, then re-tie
it with the old object. I'm sure the need has occured many times for
many people in the past, but noone's bothered to put it up on CPAN until
relatively recently.
Oh, there is one thing obvious you're missing: Your autoload sub falls
off the end if $code isn't defined. It ought to die in such a case.
Also, in the case of all the other method calls, you've lost your $self,
due to having shifted it off. You need to either unshift it for the
regular method calls, or only unshift it for the TIE<FOO> case.
Also, our() isn't backwards-compatible. And since you don't have 'use
strict', you don't need it.
Ok, that's three obvious things, so sue me :)
package Tie::Simple;
sub AUTOLOAD {
my ($self) = @_;
shift, return bless { @_ }, $self unless ref $self;
$AUTOLOAD =~ /.*::(.*)/ or die "Inernal Error";
goto &{ $self->{$1} or
((require Carp), Carp::croak("No such method: $1"))
};
}
1;
__END__
--
tr/`4/ /d, print "@{[map --$| ? ucfirst lc : lc, split]},\n" for
pack 'u', pack 'H*', 'ab5cf4021bafd28972030972b00a218eb9720000';
nob...@mail.com
> Brian McCauley wrote:
> >
> > I keep finding myself wanting a module like the following so that I
> > can create one-off tied variables without the hassle of creating a
> > class for each.
> >
> > package Tie::Simple;
> >
> > sub AUTOLOAD {
> > my $self = shift;
> > # All class methods are the contstuctor
> > return bless { @_ }, $self unless ref $self;
> > my $code = $self->{(our $AUTOLOAD =~ /(\w+)$/)[0]};
> > goto &$code if $code;
> > }
> >
> > 1;
> >
> > __END__
> >
> > I find it hard to belive that nothing of this sort exists in the
> > standard modules let alone CPAN.
> >
> > Am I missing something really obvious?
>
> I don't think so. Consider the Tie::Restore module, which is quite
> useful if you need to untie an object, do something with it, then re-tie
> it with the old object.
I can't see how that is relevant here since that is a solutionm to a
completely different problem.
> I'm sure the need has occured many times for
> many people in the past, but noone's bothered to put it up on CPAN until
> relatively recently.
Yeah, I had my own home-rolled Tie::Restore for ages.
> Oh, there is one thing obvious you're missing: Your autoload sub falls
> off the end if $code isn't defined. It ought to die in such a case.
Hmmm... yes.
> Also, in the case of all the other method calls, you've lost your $self,
> due to having shifted it off.
Yep, that's intensional. There's nothing in %$self except the
dispatch table - the the functions called by the dipatch table have no
need to use it. Logically the things listed in the dispatch table are
simple subroutines not methods.
> Also, our() isn't backwards-compatible.
A year ago I'd have agreed but from my point of view we're past the
point where that matters now. But OK, I were to submit this to CPAN
I'd use vars.
> And since you don't have 'use strict', you don't need it.
Except in -e scripts I _always_ have use strict and warnings even if
the fragment I posted didn't include it.
> $AUTOLOAD =~ /.*::(.*)/ or die "Inernal Error";
Y'know, it strikes me that "Internal Error" contains no more
information than "Died". When I tag "or die" onto a m// that I expect
to always match I'd rather not invent an unhelpfull message (and risk
spelling mistakes) when there's a perfectly good default unhelpfull
message.
Miko O'Sullivan
> package Tie::Simple;
> sub AUTOLOAD {
> my ($self) = @_;
> shift, return bless { @_ }, $self unless ref $self;
> $AUTOLOAD =~ /.*::(.*)/ or die "Inernal Error";
> goto &{ $self->{$1} or
> ((require Carp), Carp::croak("No such method: $1"))
> };
> }
> 1;
> __END__
May I join in? This is a groovy idea. Definitely something that
ought to be on CPAN. A few thoughts occurred to me about the code so
far:
- the module requires you to define all the tied hash methods, instead
of just the ones where you want the hash to behave different from the
standard
- you can't use any of the names of tied hash methods as keys for real
data
- I thought perhaps "Tie::OneOff" would be a more descriptive name
So, in the spirit of the thing, here's my modification:
<< begin >>
package Tie::OneOff;
use strict;
use vars qw[$AUTOLOAD %subs];
sub TIEHASH {
my ($class, %subs) = @_;
my $self = bless({'dat'=>{}, 'subs'=>\%subs }, $class);
$subs{'TIEHASH'} and &{$subs{'TIEHASH'}($self->{'dat'})};
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $subname = $AUTOLOAD;
$subname =~ s/^.*\:// or die "Internal Error";
$self->{'subs'}->{$subname} and
return &{ $self->{'subs'}->{$subname}}($self->{'dat'}, @_);
&{$subs{$subname}}($self, @_);
}
$subs{'FETCH'} = sub{$_[0]->{'dat'}->{$_[1]}};
$subs{'STORE'} = sub{$_[0]->{'dat'}->{$_[1]} = $_[2]};
$subs{'DELETE'} = sub{delete $_[0]->{'dat'}->{$_[1]}};
$subs{'EXISTS'} = sub{exists $_[0]->{'dat'}->{$_[1]}};
$subs{'CLEAR'} = sub {%{$_[0]->{'dat'}} = ()};
$subs{'FIRSTKEY'} = sub {
scalar(keys %{$_[0]->{'dat'}});
$_[0]->NEXTKEY();
};
$subs{'NEXTKEY'} = sub {
my $v = (each %{$_[0]})[1];
($v ? $v->[0] : undef );
};
DESTROY {
$_[0]->{'subs'}->{'DESTROY'} and
&{$_[0]->{'subs'}->{'DESTROY'}($_[0]->{'dat'})};
}
# return true
1;
<< end >>
The code above allows you to override every method, including DESTORY
and TIEHASH itself. The overridden subs get just the hash ref to the
data itself, not the "real" object, so you can set any key you want.
Here's an example of code that works with the module above:
#!/usr/local/bin/perl -w
use strict;
use Tie::OneOff;
my (%hash);
tie %hash, 'Tie::OneOff', STORE=>\&lc_crunch_store,
FETCH=>\&lc_crunch_fetch;
$hash{' YO DUDE '} = 'whatever';
print $hash{'yo Dude'};
# lowercase and crunch key before storing
sub lc_crunch_store {
my ($s, $k, $v) = @_;
$s->{lc_crunch($k)} = $v;
}
# lowercase and crunch key to retrieve
sub lc_crunch_fetch {
my ($s, $k, $v) = @_;
return $s->{lc_crunch($k)};
}
# lowercase and "crunch" key before storing
sub lc_crunch {
my ($k) = @_;
$k =~ s|^\s+||;
$k =~ s|\s+$||;
$k =~ s|\s+| |;
return lc($k);
}
nob...@mail.com
> Benjamin Goldberg <gol...@earthlink.net> wrote in message news:<3D471364...@earthlink.net>...
>
> > package Tie::Simple;
> > sub AUTOLOAD {
> > my ($self) = @_;
> > shift, return bless { @_ }, $self unless ref $self;
> > $AUTOLOAD =~ /.*::(.*)/ or die "Inernal Error";
> > goto &{ $self->{$1} or
> > ((require Carp), Carp::croak("No such method: $1"))
> > };
> > }
> > 1;
> > __END__
>
> May I join in? This is a groovy idea. Definitely something that
> ought to be on CPAN. A few thoughts occurred to me about the code so
> far:
>
> - the module requires you to define all the tied hash methods,
Who said anything about hashes? This module makes no preconceptions
about the type of tied thing. Usually I'd use Tie::Simple for
scalars.
I would, however, agree that it shouldn't croak on a missing DESTROY.
> instead
> of just the ones where you want the hash to behave different from the
> standard
You seem to be re-inventing Tie::StdHash
> - you can't use any of the names of tied hash methods as keys for real
> data
You are supposing that the hash blessed into Tie::Simple contains
instance data. That's not my intension - because that wouldn't be
"Simple". The idea is that Tie::Simple like _simply_ directly
providing subroutine (not method) handlers for the tied variable
without there being an associated object. The instance data is in the
pads of the closures.
sub wibble : lvalue {
my $instance_variable = do {
# Stuff that is common to wibble in a lvalue and rvlaue context
}
tie my $tied, 'Tie::Simple' =>
FETCH => sub {
# Stuff to do when wibble called as rvalue
},
STORE => sub {
my $value = shift;
# Stuff to do when wibble called as lvalue
};
$tied;
}
See also: <u97kxwz...@wcl-l.bham.ac.uk>
http://groups.google.com/groups?selm=u97kxwzfnd.fsf%40wcl-l.bham.ac.uk
Miko O'Sullivan
> > instead
> > of just the ones where you want the hash to behave different from the
> > standard
>
> You seem to be re-inventing Tie::StdHash
I don't see how you come to that conclusion. The Perldocs for
Tie::StdHash are quite clear: to use it, you need to override it with
your own class. That's exactly not the point of what we've been
discussing.
But obviously we're simply discussing a very different set of
requirements. Your suggestions focus on providing a class for which
you supply all the class methods through the tie command. My ideas
focus on providing a tied hash class behaves like a "normal" hash but
allows you to indicate methods to substitute. These are both useful
and simply different ideas.
If you choose to post your module on CPAN, that would be cool. If you
need it probably somebody else does. I would only disagree with the
choice of the namespace "Tie::Simple". You module provides some cool
functionality, but it doesn't seem to me to make tying hashes simpler,
it makes it more complex.
-Miko
nob...@mail.com
> But obviously we're simply discussing a very different set of
> requirements.
Yes, but they are not actually incomatible.
> Your suggestions focus on providing a class for which
> you supply all the class methods through the tie command.
Yes, more precisely I focus on a more simple model of tying a variable
that does not appear to involve objects and methods.
> My ideas
> focus on providing a tied hash class behaves like a "normal" hash but
> allows you to indicate methods to substitute.
That's what's achived by inheritance.
If you are going to create the STORE/FETCH/whatever handlers as named
subroutines that take some sort of intermediate object as the first
argument then rather than inveting your own naming convention you may
as well give them then canonical names in their own namespace. Having
done that all you need to do is make namespace's @ISA point to
Tie::StdXXXXX and you've done what you wanted.
I stand by my statement that you are re-inveting Tie::StdHash. You
seem to believe that sub-classing is complex, whereas actually you are
doing something just as complex to avoid it.
> If you choose to post your module on CPAN, that would be cool. If you
> need it probably somebody else does. I would only disagree with the
> choice of the namespace "Tie::Simple". You module provides some cool
> functionality, but it doesn't seem to me to make tying hashes simpler,
> it makes it more complex.
I didn't claim that it made a complex task simple. I chose the name
because it was a conceptually simpler model of tying a variable by
pretending that the intermediate object doesn't exist and that we tie
a variable directly to a set of subroutines.
Since the name clearly gave you the wrong impression I'll adopt your
suggestion of the Tie::OneOff name.
> These are both useful and simply different ideas.
But they can be combined by adding a BASE attribute to Tie::OneOff
that means that if there's no explicit method specified then simply do
the natural thing to the BASE thing.
# lowercase and "crunch" key before storing
sub lc_crunch {
my ($k) = @_;
$k =~ s|^\s+||;
$k =~ s|\s+$||;
$k =~ s|\s+| |;
return lc($k);
}
tie my %hash, 'Tie::OneOff'
BASE => \my %h,
STORE => sub{
my ($k, $v) = @_;
$h{lc_crunch($k)} = $v;
},
DELETE => sub{
my ($k) = @_;
delete $h{lc_crunch($k)};
},
FETCH => sub {
my ($k) = @_;
$h{lc_crunch($k)};
};
BTW, FYI: this is actually implemented by blessing \%h it
Tie::StdHash.