{
# 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();