print "$o{0} $o{0}->{hi}\n";
####
print "$o{0}->{hi}\n";
####
{
# implements persistence based on dirty and tied persistence in %o
package Pwo;
our %o;
our $keep;
sub flush { for (values %o) {
if($_->{dirty}) { delete $_->{dirty}; $keep->keep($_);
print "k: $_->{hi} ";
}}}
sub Pwo {
my($class,$filename)=@_;
$class=ref($class) || $class;
$keep=tie(%o, pwotie, $filename) || die "Pwo: Persistence failed: ", join(', ',@dbm)," -- error:$!\n";
my $self={
'o'=>\%o,
};
bless $self,$class;
# if this is a new install we need to load the base objects
print "o{0}=$o{0}\n";
bootstrap() unless defined $o{0};
print "o{0}=$o{0} 0=$o{0}->{hi} 1=$o{1}->{hi}\n";
return $self;
}
sub bootstrap {
print "bs\n";
$o{0}={hi=>there, how=>'are you', dirty=>1, oid=>0};
$o{1}={hi=>"woof",dirty=>1,oid=>1};
}
}
{
package pwotie;
use Data::Dump qw(dump);
use GDBM_File;
sub TIEHASH {
my ($class,$filename)=@_;
$Result = tie(%f, 'GDBM_File', $filename, 2, 0640); ## duno what's wrong with my perl -- GDBM_WRCREAT=2 for me.
if (! $Result){
print "\n\nCould not open GDBM file '$filename': $!\n";
}
return bless { file=>$filename, f => \%f, l => () }, $class;
}
sub keep {$_[0]->{f}{$_[1]->{oid}}=dump($_[1]); print "sto: ".dump($_[1])."\n";}
sub STORE { my ($this, $key, $value)=@_;
return $this->{l}{$key}=($value);
}
sub FETCH { my ($this, $key)=@_;
return $this->{'l'}{$key} if exists $this->{'l'}{$key};
print "trying f's $key: $this->{f}{$key}\n";
$this->{'l'}{$key}=eval($this->{f}{$key});
return $this->{'l'}{$key};
}
sub FIRSTKEY { my $a = scalar keys %{$_[0]->{l}}; each %{$_[0]->{l}}; }
sub NEXTKEY { each %{$_[0]->{l}}; }
sub EXISTS { my ($this, $key)=@_; return exists $this->{f}{$key};}
sub DELETE {my ($this, $key)=@_;
delete $this->{l}{$key};
delete $this->{f}{$key};
}
sub CLEAR {my ($this)=@_;
undef %{$this->{l}};
undef %{$this->{f}};
}
}
$p=Pwo->Pwo("tst.db" );
$p->flush();