Tie & Destroy, OOP

Flame has asked for the wisdom of the Perl Monks concerning the following question:

I'm afraid this is a very long and complex question, or at least it appears to be one.

Contents of GMS/MemberFile.pm

package GMS::MemberFile;
require 5.6.0;
use strict;
require GMS;
require Tie::Hash;
use Carp;

our $VERSION = "0.75";
our @ISA = ("GMS","Exporter","Tie::StdHash");

our @EXPORT = qw();

our @EXPORT_OK = qw();

our $GMS = new GMS(settings => 1);

#USE: tie(%HASH,"GMS::MemberFile",{UID=>123,NAME=>'John'});
#Accepted Arguments
#UID=>UID
#NAME=>NAME
#GENFILE=>1/0
#READONLY => 1/0
#Under normal circumstances, the only required field is UID... when ge
+nerating
#a file, however, NAME and GENFILE are required, and if UID is specifi
+ed
#the tie will fail.
#Using READONLY on, you cannot change values, readonly is ignored if g
+enfile is active

sub TIEHASH {
   my ($self,%DETAIL) = @_;
   my ($this,$filedata,$ini,$uid,$tohash, $name);

   unless(exists $DETAIL{UID} xor $DETAIL{GENFILE}){
      croak "Missing UID in TIE attempt or UID provided while construc
+ting new file, UID = $DETAIL{UID}, GENFILE = $DETAIL{GENFILE}";
   }

   #my $MEMBERDIRL = $GMS->getsetting("FILE","MEMBERDIRL");
   my $MEMBERDIRL = 'TestMember\\';

   if($DETAIL{GENFILE}){
      $DETAIL{READONLY} = 0;
      croak "Missing MemberName in memberfile generation attempt" unle
+ss($DETAIL{'MEMBER'});
      #$uid = $GMS->getsetting("OTHER","UIDCOUNT") + 1;
      $uid = 1;
      $ini = new IniFile("$MEMBERDIRL$DETAIL{'MEMBER'}.gmf");
      croak "Error, UID retrieved from settings already exists" if($in
+i->exists([$uid]));
      $ini->put([$uid,"UID",$uid], -add => 1);
      $ini->put([$uid,"DATEJOIN", time], -add => 1);
      $ini->save();
      #$GMS->changesetting("OTHER","UIDCOUNT",$uid);
      #print "Saved GenFile as $MEMBERDIRL$DETAIL{'MEMBER'}.gmf";
   }else{
      $uid = $DETAIL{'UID'};
      if(exists $DETAIL{MEMBER} && defined $DETAIL{MEMBER} && -e "$MEM
+BERDIRL$DETAIL{MEMBER}.gmf"){
         $ini = new IniFile("$MEMBERDIRL$DETAIL{MEMBER}.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEM
+BER'}.gmf" unless($ini->exists([$uid]));
      }else{
         my $mlist = new IniFile($MEMBERDIRL."memberlist.gms");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL"."memberlis
+t.gms" unless($name = $ini->get(['UID',$uid], -mapping => 'single'));
         $ini = new IniFile("$MEMBERDIRL$name.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEM
+BER'}.gmf" unless($ini->exists([$uid]));
      }
   }

   $tohash = $ini->get([$uid]);
   #print "$tohash";
   croak "Unknown Error retrieving file data: $!" unless(ref($tohash))
+;


   $filedata = {_ini => $ini,
                _uid => $uid,
                _read => $DETAIL{'READONLY'},
                _keylist => {}
               };

   #print " Generated filedata hash\n";
   my %temparray = getdatakey($ini,$uid);
   $filedata->{_keylist} = \%temparray;
   #print "\n"."returning";
   return bless $filedata, $self;

}


sub FETCH {

   my($self,$key) = @_;

   my $ini = $self->{_ini};
   my $uid = $self->{_uid};

   croak "Unable to locate $key" unless($ini->exists([$uid,$key]));

   return $ini->get([$uid,$key], -mapping => 'single');

}

sub STORE {

   my($self,$key,$change) = @_;

   if(!$self->{_read}){
      my $ini = $self->{_ini};
      croak "INI Missing" unless(ref $ini);
      my $uid = $self->{_uid};
      $ini->delete([$uid,$key]);
      $ini->put([$uid,$key,$change], -add => 1);
      my %temp = getdatakey($ini,$uid);
      $self->{_keylist} = \%temp;
   }
   print "Store $key, $change";
}

sub DELETE {
   my($self,$key) = @_;

   if(!$self->{_read}){
      my $ini = $self->{_ini};
      my $uid = $self->{_uid};

      $ini->delete([$uid,$key]);

      my %temp = getdatakey($ini,$uid);
      $self->{_keylist} = \%temp;
   }
}

sub FIRSTKEY {
   my($self,$key) = @_;
   my $temp = keys(%{ $self->{_keylist} });
   return scalar each %{ $self->{_keylist} };
}

sub NEXTKEY {
   my $self = shift;
   return scalar each %{ $self->{_keylist} };
}


sub DESTROY {
  print "Attempting Save";
  my $self = shift;
  my $ini = $self->{_ini};
  print "Ini Is: ".ref $ini;
  if(!$self->{_read}){
    print "Stage 2\n";
    #Fails here
    my $ini = $self->{_ini};
    print "Stage 3: ini = $ini !!!\n";
    print ref $ini;
    croak "\n\nError retrieving INI interface" unless(ref $ini);
    print "Stage 4\n";
    $ini->save() || croak "Failed Save! $!";
    print "Saved!\n";
  }else{
     print "Skiping due to read only";
  }
}


#Send it the INI and the UID, it should be able to determine the curre
+nt list of keys
sub getdatakey {
   return;
   my($ini,$uid) = @_;
   my (%temp,$key);

   my %testhash = %{ $ini->get([$uid]) };

   foreach $key (keys %testhash){
      $temp{$key} = 1;
      #print "Processing '$key'";
   }
   #print "Finished Getdatakey\n";
   return %temp;

}

1;
[download]

The test program, testtie.cgi:

#!/usr/bin/perl
use GMS::MemberFile;

%member;

tie(%member,"GMS::MemberFile", MEMBER=>'Iron', GENFILE => 0, UID=> 1);
print "The UID for the new member is $member{UID}\n";
print "Did Ini Exit already?";
[download]

Explanation: The goal of the GMS::MemberFile package, was to provide a tied hash-link to the IniFile commands, which would also command IniFile to save after the last use of the current file using DESTROY

The problem is, the INI object, which is stored in the MemberFile object, is being destroied before MemberFile for some reason I don't understand... and it is destroying twice, although it only created one object (The output from executing testtie is pasted below)

Is there some reason that INI is vanishing before the object that holds it?

Note: I have added a small destroy sub to the IniFile package, it simply prints a warning that IniFile is gone... which is how I know it is destroying twice.

Execution Result:
-------------
E:\GMS>perl -w testtie.cgi
Odd number of elements in hash assignment at GMS.pm line 40.
Useless use of a variable in void context at testtie.cgi line 11.
The UID for the new member is 1
Did Ini Exit already?

IniFile is exiting!

IniFile is exiting!

Attempting SaveIni Is: Stage 2
Use of uninitialized value in concatenation (.) at GMS/MemberFile.pm line 148 during global destruction.
Stage 3: ini = !!!
(in cleanup)

Error retrieving INI interface at testtie.cgi line 0

-----------
End of result

So, if anyone can help me, I would appreciate it, I'm sorry this question is so long, but I'm not yet experienced enough at Perl OOP to single out what could be causing the problem.

Please ask me to clarify anything that doesn't make sense.

The code was executed with -w

Flame ~ Lead Programmer: GMS
http://gms.uoe.org
"Wierd things happen, get used to it"

Comment on Tie & Destroy, OOP Select or Download Code

Replies are listed 'Best First'.
Re (tilly) 1: Tie & Destroy, OOP by tilly (Archbishop) on Aug 09, 2001 at 08:36 UTC
The problem is that your object is in a global variable and so survives to global destruction. During global destruction Perl just goes and destroys things in an essentially random order. This could be considered a bug in Perl (even though it was documented) and will be fixed in Perl 5.8. However note that the fix depends heavily upon the fact that Perl uses reference counting, and not true garbage collection. It would not be safe to assume that Perl 6 will necessarily have reliable support for expected destruction mechanics. In Perl 5.6 you could work around the issue by keeping track of created objects through WeakRefs and then in an END block destroying everything that didn't clean itself up. You might think that you could just have the ini object be responsible for cleaning itself up, regardless of whether you had a tied interface to it or not. Unfortunately data that it depends upon might be cleaned up before it is, leading to data corruption. So you are just moving the problem around, but to really solve it you need to guarantee that the destruction happens before global destruction is hit.	[reply]
Re: Re (tilly) 1: Tie & Destroy, OOP by Flame (Deacon) on Aug 09, 2001 at 21:36 UTC
Hmm, this is interesting, so what would it do if every time it was used, it was declared to be 'my' (even when it's not in a sub/package)? Does that mean it needs to be destroied before the garbage is collected? Starts experementing "Wierd things happen, get used to it" Flame ~ Lead Programmer: GMS http://gms.uoe.org	[reply]
Re (tilly) 3: Tie & Destroy, OOP by tilly (Archbishop) on Aug 09, 2001 at 21:45 UTC
Lexical or not, the question is whether the data is garbage collected before the end of the program. If it is done before then you get reliable destruction mechanics that we all know and love. If it is done in the final global destruction, data is terminated with prejudice at random. BTW another solution that comes to mind is to use a flyweight pattern for your objects. That puts all of your current objects into a convenient hash that you can iterate through in an END block to do cleanup. Doing things that way gives you 2 wins. Better encapsulation, and it solves the global destruction problem in a way that is more likely to work across versions of Perl.	[reply]
(tye)Re: Tie & Destroy, OOP by tye (Sage) on Aug 10, 2001 at 01:05 UTC
Re (tilly) 5: Tie & Destroy, OOP by tilly (Archbishop) on Aug 10, 2001 at 01:27 UTC
Some notes below your chosen depth have not been shown here
Re: Re: Re (tilly) 1: Tie & Destroy, OOP by Flame (Deacon) on Aug 09, 2001 at 21:46 UTC
It worked! I was able to get it to destroy before the garbage collection by giving it a my declaration... IE: `my %member; tie(%member, "GMS::MemberFile", UID=>3);` [download] "Wierd things happen, get used to it" Flame ~ Lead Programmer: GMS http://gms.uoe.org	[reply] [d/l]
Re: Tie & Destroy, OOP by bikeNomad (Priest) on Aug 09, 2001 at 21:34 UTC
If you get rid of your objects before global destruction time, you won't have these problems. One solution is just to make sure that the objects are in an inner lexical scope: `{ my $global = ...; sub doSomething { $global->whatever() } }` [download] Another solution is to deliberately clear object references in an END block: `use strict; $^W++; $\|++; package A; sub new { my $self = bless {}, $_[0]; print "construct $self\n"; $self; } # Package destructor sub END { print "in global destruction\n"; } # Object destructor sub DESTROY { print "destroying $_[0]\n"; } package main; our $a = A->new(); END { $a = undef; }` [download]	[reply] [d/l] [select]
Re: Tie & Destroy, OOP by mothra (Hermit) on Aug 10, 2001 at 17:17 UTC
The real problem here is that you're relying on a destructor to do real cleanup work. That's not a good idea because a.) destructors don't always get reliably called, b.) it's possible that you may end up referring to objects in your destructor that have already been destroyed (ahem :). A destructor should be more of a "backup plan" that calls your "cleanup" routine a second time. That is, your "cleanup" rountine should be called at least once by you, and be written in such a way that it won't blow up if it gets called twice (because many times it will get called a second time by your "backup"..the destructor).	[reply]