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"