OOP & tie - Dev Shed

Dev Shed Forums Sponsor:

August 6th, 2001, 05:20 PM

Flame

Member

Join Date: Apr 2001

Posts: 25

Time spent in forums: < 1 sec
Reputation Power: 0

OOP & tie

I'm having a bit of a problem...

Vanishing attributes

I'll try to post the source here, but it's long.

File: GMS.pm

Code:

package GMS;
use IniFile;
use strict;
require Exporter;

our $VERSION = "0.50";

our @ISA = ("Exporter");

our @EXPORT = qw();

our @EXPORT_OK = qw();


sub new {

   my $class = shift;

   my %acess = shift;

   my $self = {};

   #Preload any files they specify a need for
   #List of keys:
   # settings
   # divisions
   # memberlist

   my($settings,$memblist,$path);

   $settings = new IniFile("GMSSettings.gms");

   $path = $settings->get(['FILE','MEMBERDIRL'], -mapping => 0);

   if($acess{'settings'}){
      $self->{_settings} = $settings;
   }

   if($acess{'divisions'}){
      $self->{_divdir} = new IniFile($path."division.gms");
      $self->{_divlist} = new IniFile($path."divlist.gms");
   }

   if($acess{'memberlist'}){
      $self->{_members} = new IniFile($path."memberlist.gms");
   }

   my $self = {_settings => $settings};
   return bless($self,$class);

}

#Get settings
sub getsetting {
   my ($section,$field,$ini);

   my $self = shift;

   if(ref $self && $self->{_settings}){
      ($section,$field) = @_;
      $ini = $self->{_settings};
   }else{
      $section = $self;
      $field = shift;
      undef $self;
      $ini = new IniFile("GMSSettings.gms");
   }

   my $setting = $ini->get([$section,$field], -mapping => 'single');

   return $setting;

}

sub changesetting {

   my $self = shift;
   my ($section,$id,$new) = @_;

   $self->{_settings}->delete([$section,$id]);
   $self->{_settings}->put([$section,$id,$new], -add => 1);
   $self->{_settings}->save();
   return 1;
}

1; #Return 1

File: GMS/MemberFile.pm

Code:

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 generating
#a file, however, NAME and GENFILE are required, and if UID is specified
#the tie will fail.
#Using READONLY on, you cannot change values, readonly is ignored if genfile 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 constructing 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" unless($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($ini->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 "$MEMBERDIRL$DETAIL{MEMBER}.gmf"){
         $ini = new IniFile("$MEMBERDIRL$DETAIL{MEMBER}.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEMBER'}.gmf" unless($ini->exists([$uid]));
      }else{
         my $mlist = new IniFile($MEMBERDIRL."memberlist.gms");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL"."memberlist.gms" unless($name = $ini->get(['UID',$uid], -mapping => 'single'));
         $ini = new IniFile("$MEMBERDIRL$name.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEMBER'}.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 {
   my $self = shift;
   print "Checking Ini: ".ref($self->{_ini});

   foreach my $key (keys %$self){
      print "$key is ".ref $self->{$key}."\n";
   }

   print "\n\nDestroying $self";
   savefile($self);
}


#Send it the INI and the UID, it should be able to determine the current list of keys
sub getdatakey {
   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;

}

sub savefile {
  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 "Error 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";
  }
}

1;

testtie.cgi

Code:

#!/usr/bin/perl

#use lib '/webs/gms/cgi-bin/Modules';
use CGI qw(:standard);
use GMS::MemberFile;

#print header;

#system "perl -v";

%member;

tie(%member,"GMS::MemberFile", MEMBER=>'Iron', GENFILE => 1);

print "The UID for the new member is $member{UID}\n";
print "and he joined on $member{'DATEJOIN'}\n";

$member{'EMAIL'} = 'flame@berkshire.rr.com';

print "His email address is $member{'EMAIL'}";

Now, although that may be hard to follow, (I didn't do a good job of commenting it...), I'll try to explain it...

It is suppost to allow me to automatically modify an INI file, by changing the hash, and save as soon as the variable is out of use (Through the Destroy sub)

The problem is... this is the output I get from the testtie.cgi program...

Quote:

The UID for the new member is 1
and he joined on 997135933
Store EMAIL, flame@berkshire.rr.comHis email address is flame@berkshire.rr.comCh
ecking Ini: _keylist is _ini is _uid is _read is

Destroying GMS::MemberFile=HASH(0x1b4933c)Attempting SaveIni Is: Stage 2
Stage 3: ini = !!!

(Note: Most of the print statements that create the output within the package GMS::MemberFile are there as part of my testing, to help me locate the problem)

The object, ini, which is from the module IniFile, is assigned as an attribute to the object created by the tie command.

In all the other commands, _ini is available, as are the other four variables assigned to it... however, all of a sudden, once it reaches destroy, EVERYTHING is gone... I have keys with no values in the hash...

I'm new to oop, but I don't think that that was suppost to happen... Can anyone point to what I did wrong?

(I know this is rather long and complex, so anyone that takes the time to even scan it has my thanks.)

Thank you

August 8th, 2001, 10:45 AM

Flame

Member

Join Date: Apr 2001

Posts: 25

Time spent in forums: < 1 sec
Reputation Power: 0

Ok...

I have had some time to think, and shorten the script, this should be easier to scan over

The Package GMS is unimportant

IniFile was (by me) given a simple destroy sub that prints "IniFile is exiting!"

File: GMS/MemberFile.pm

Code:

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 generating
#a file, however, NAME and GENFILE are required, and if UID is specified
#the tie will fail.
#Using READONLY on, you cannot change values, readonly is ignored if genfile 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 constructing 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" unless($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($ini->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 "$MEMBERDIRL$DETAIL{MEMBER}.gmf"){
         $ini = new IniFile("$MEMBERDIRL$DETAIL{MEMBER}.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEMBER'}.gmf" unless($ini->exists([$uid]));
      }else{
         my $mlist = new IniFile($MEMBERDIRL."memberlist.gms");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL"."memberlist.gms" unless($name = $ini->get(['UID',$uid], -mapping => 'single'));
         $ini = new IniFile("$MEMBERDIRL$name.gmf");
         croak "Unable to locate UID '$uid' in $MEMBERDIRL$DETAIL{'MEMBER'}.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;

  #attempt to retrieve INI
  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 current 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;

File: testtie.cgi

Code:

#!/usr/bin/perl

#use lib '/webs/gms/cgi-bin/Modules';
use CGI qw(:standard);
use GMS::MemberFile;

#print header;

#system "perl -v";

%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?";
#print "and he joined on $member{'DATEJOIN'}\n";

#$member{'EMAIL'} = 'flame@berkshire.rr.com';

#print "His email address is $member{'EMAIL'}";

Both have been modified.

This is the current output...

Quote:

The UID for the new member is 1
Did Ini Exit already?

IniFile is exiting!

IniFile is exiting!

Attempting SaveIni Is: Stage 2
Stage 3: ini = !!!

For some reason, it is exiting IniFile twice...

Is there some reason IniFile is being destroyed before MemberFile? It doesn't make sense...

Thread Tools	Search this Thread
Email this Page	Search this Thread: Advanced Search
Display Modes	Rate This Thread
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode	Rate This Thread: