|
ru.cgi.perl
- RU.CGI.PERL ------------------------------------------------------------------
From : Andrey Sapozhnikov 2:5020/400 15 Jul 2002 18:23:05
To : Dmitry Koteroff
Subject : Re: еще раз об экспорте [Was: Открытое письмо...]
--------------------------------------------------------------------------------
Dmitry Koteroff wrote:
> Если использовать только tie, то изменения в IN будут видны в пакете, но
> изменения в пакете не будут видны в IN (я имею в виду изменения - добавления
> новой переменной, а не изменение старой). Или как-то можно выполнить tie и
> для "стэша" (так, кажется, он называется?) того пакета?..
Hет, для стэша tie не сделать. Да и не надо.
> Просто хочется сделать $IN{a} и $IN'a полными синонимами в обе стороны.
Для этого достаточно сделать tied %IN.
========================== PkgHash.pm =============================
package PkgHash;
use strict;
use warnings;
sub TIEHASH {
my ($type, $pkg) = @_;
unless ($pkg =~ /^main::.*::$/) {
$pkg = "main$pkg" if $pkg =~ /^::/;
$pkg = "main::$pkg" unless $pkg =~ /^main::/;
$pkg .= '::' unless $pkg =~ /::$/;
}
my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
my $stem_symtab;
{
no strict "refs";
$stem_symtab = *{$stem}{HASH};
}
die "Cannot find symtab for $pkg" unless
defined $stem_symtab and exists $stem_symtab->{$leaf};
bless {
PACKAGE => $pkg,
SYMTAB => *{$stem_symtab->{$leaf}}{HASH}
}, $type;
}
sub FETCH {
my ($self, $key) = @_;
return unless exists $self->{SYMTAB}->{$key};
local *sym = $self->{SYMTAB}->{$key};
return *sym{HASH} || *sym{ARRAY} || ${*sym{SCALAR}};
}
sub STORE {
my ($self, $key, $value) = @_;
$key =~ /^[a-z_][\da-z_]*$/i or die "Wrong symbol name: $key";
local *sym;
{
no strict "refs";
*sym = *{$self->{PACKAGE} . $key};
}
*sym = $value if ref $value;
*sym = \$value;
}
sub DELETE {
my ($self, $key) = @_;
exists $self->{SYMTAB}->{$key} or return;
my $value = $self->FETCH($key);
undef *{$self->{SYMTAB}->{$key}};
delete $self->{SYMTAB}->{$key};
$value;
}
sub CLEAR {
my ($self) = @_;
foreach (keys %{$self->{SYMTAB}}) {
/^[a-z_][\da-z_]*$/i or next;
undef *{$self->{SYMTAB}->{$_}};
delete $self->{SYMTAB}->{$_};
}
}
sub EXISTS {
my ($self, $key) = @_;
exists($self->{SYMTAB}->{$key});
}
sub FIRSTKEY {
my ($self) = @_;
$self->{KEYS} = {};
my @keys = keys %{$self->{SYMTAB}};
$self->{KEYS}->{$keys[$_]} = $keys[$_ + 1] foreach 0..$#keys;
return $keys[0];
}
sub NEXTKEY {
my ($self, $key) = @_;
return $self->{KEYS}->{$key};
}
sub UNTIE {
1;
}
sub DESTROY {
1;
}
1;
============================== EOF ==========================
============================ test.pl ========================
#!/usr/bin/perl -w
use strict;
use PkgHash;
# Create package
{ package IN; }
# Create hash
our %IN;
# Tie hash to class PkgHash
tie %IN, 'PkgHash', 'IN';
# ------------ Tests ---------------
$IN::a = 'aaaaa';
print "should be 'aaaaa' => ", $IN{a}, "\n";
$IN::a .= 'bbbbb';
print "should be 'aaaaabbbbb' => ", $IN{a}, "\n";
$IN{a} .= 'ccccc';
print "should be 'aaaaabbbbbccccc' => ", $IN::a, "\n";
print exists($IN{a}) ? "\$IN{a} exists: OK\n" :
"\$IN{a} not exists: Not OK\n";
print "Was keys (should be a, b) => ", join(', ', keys %IN), "\n";
print "Delete \$IN{a}\n";
my $old = delete $IN{a};
print "Old value (should be 'aaaaabbbbbccccc') => $old\n";
print exists($IN{a}) ? "Delete: Not OK\n" : "Delete: OK\n";
print "Now keys (should be a) => ", join(', ', keys %IN), "\n";
$IN{b} = 8;
print "should be 8 =>", $IN::b, "\n";
my %x = %IN::b;
print "should be 8, but %IN::b autovivified, and we cannot " ,
"detect which slot contains right data now... => $IN{b}\n";
=========================== EOF ============================
Вот рабочий скелет, только опасайтесь autovivify - он порождает
переменную... тут уж ничего не сделать, кроме как поиграться
с приоритетами - из какого слота данные актуальнее. Hапример
сделать так:
non-empty hash
non-empty array
defined scalar
hash
array
undef scalar
Андрей
P.S. или бросить фигней заниматься. Hу чем просто хэш не устроил?
Зачем еще неймспейс заводить?
--- ifmail v.2.15dev5
* Origin: Demos online service (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
