Re: tie::file - file modification status

OK, I think I got it working. forget Tie::Watch, I could not get that to work (though I am sure it can be made to) but I have created a little package called Sensitive_Array. this will set a global variable when the watched array is altered, dirty I know but that's the way the code grew. It also prints out the methods being called. I did not implement it all, but more than enough for this example.

Make @watched_array the array your code is using, do not touch @array directly

First the test code

#!/usr/bin/perl
use strict;
use warnings;
use Tie::File;
use Sensitive_Array;

# this is the global var I am using
$main::touched=0;
my (@array, @watched_array);
my $file='test_tie_file';

# First tie the array to the file
tie @array, 'Tie::File', $file or die "cannot tie to $file: $!\n";
push @array, int (rand 1000) until $#array > 39; # fill it on the firs
+t pass

# now tie it up to an array that will tell us when it was altered
tie @watched_array, 'Sensitive_Array', \@array;

print "array of length $#watched_array is now watched\n";

print "would you like to alter the file (y/n)\n";
my $ansa=<STDIN>;
push @watched_array, 'touched' if $ansa =~/^y/;

untie @array;

if ($main::touched) {
    print "File has been altered\n"
} else {
    print "File remains the same\n";
}
[download]

And here is the package, it is heavily borrowed from the example in the tie documentation

#!/usr/bin/perl
use strict;
use warnings;

package Sensitive_Array;
{
    use Carp;
    use strict;

    sub TIEARRAY {
      my $class = shift;
      my $aref  = shift;
      if ( @_ ) {
        croak "usage: tie ARRAY, '" . __PACKAGE__ . "', ArrayRef";
      }
      return bless $aref, $class;
    }

    sub FETCH {
      my $self  = shift;
      my $index = shift;
      print " Fetch ";
      return $self->[$index];
    }

    # STORE this, index, value
    sub STORE {
      my $self = shift;
      my( $index, $value ) = @_;
      print " Store ";
      $main::touched=1;
      $self->[$index]=$value;
    }

    # FETCHSIZE this
    sub FETCHSIZE {
      my $self = shift;
      print " Fetchsize ";
      return scalar @{$self};
    }

    # STORESIZE this, count
    # I think this is right but please check !
    sub STORESIZE {
      my $self  = shift;
      my $count = shift;
      $main::touched=1;
      print " Storesize ";
      $#{$self} = $count -1 ;
    }

    # EXTEND this, count
    sub EXTEND {   
      my $self  = shift;
      my $count = shift;
      $main::touched=1;
      print " Extend ";
      $self->STORESIZE( $count );
    }

    # PUSH this, LIST
    sub PUSH {  
      my $self = shift;
      my @list = @_;
      $main::touched=1;
      print " Push ";
      push @$self, @list;
    }

    # POP this
    sub POP {
      my $self = shift;
      $main::touched=1;
      print " Pop ";
      return pop @{$self};
    }

    # SHIFT this
    sub SHIFT {
      my $self = shift;
      $main::touched=1;
      print " Shift ";
      return shift @{$self};
    }

    # UNSHIFT this, LIST
    sub UNSHIFT {
    print " not implemented ";
    }

    # SPLICE this, offset, length, LIST

    sub SPLICE {
    print " not implemented ";
    }

    # UNTIE this

    # DESTROY this
};
1;
[download]

here is the output

C:\PERL\bin>perl tie_test
 Fetchsize array of length 47 is now watched
would you like to alter the file (y/n)
y
 Push  Fetchsize File has been altered

C:\PERL\bin>perl tie_test
 Fetchsize array of length 48 is now watched
would you like to alter the file (y/n)
n
File remains the same
[download]

Cheers,
R.

Pereant, qui ante nos nostra dixerunt!

Comment on Re: tie::file - file modification status Select or Download Code