[Melbourne-pm] IO::File with Capture for Quota

[Scott Penrose]

Hey Guys

I am writing a module at the moment to capture IO::File open to allow me to work out the difference in file size at the start and end of an operation.

My code basically works, but it is a huge hack, and requires a hack on the call to make it work.

Firstly let me show you how I would expect the code to work:
(NOTE: This is not thread safe, it is demonstration code, not final)

  #!/usr/bin/perl
  use IO::File::Quota;
  
  # Set the call back - just print the new size
  $IO::File::Quota::quotaaction = sub { print "New size = ", @_, "\n" };
  
  # Open a file for append
  my $fh = new IO::File::Quota ">> /tmp/testfile1";
  
  # Print to the file
  print $fh "This is a new line\n";
  
  # Three methods of closing a file
  $fh->close;
  #close $fh;
  #undef $fh;

Above is code that works, but only if you use $fh->close before the object is destroyed. To get around this I added in a tiny hack to keep the file name.

  my $fh = new IO::File::Quota ">> /tmp/testfile1";
  $IO::File::Quota::filecache{$fh} = "/tmp/testfile1";

Now all three close methods work - $fh->close; close $fh; undef $fh - and in any order.

So before my questions, here is the actual module:

package IO::File::Quota;
use base qw/IO::File/;

# Keep a local copy of the size at the start
our %sizecache = ();
# Keep a local copy of the filename at the start
our %namecache = ();
# Callback function
our $quotaaction;

# Capture current size (maybe zero if not used)
sub open {
	my ($self, @rest) = @_;
	print STDERR "Open: " . $rest[0] . "\n";
	my $ret = $self->SUPER::open(@rest);
	$sizecache{$ret} = -s $ret;
	return $ret;
}

sub close {
	my ($self, @rest) = @_;
	print STDERR "Close\n";
	my $new = -s $self;
	if ($sizecache{$self} != $new && ref($quotaaction)) {
		$quotaaction->($new - $sizecache{$self});
	}
	delete $sizecache{$self};
	delete $filecache{$self};
	return $self->SUPER::close(@rest);
}

sub DESTROY {
	my $self = shift;
	my $new = -s $self;
	if (!defined($new) && exists($filecache{$self})) {
		$new = -s $filecache{$self};
	}
	print STDERR "DESTROY - $new\n";
	if (exists($sizecache{$self}) && $sizecache{$self} != $new && ref($quotaaction)) {
		$quotaaction->($new - $sizecache{$self});
	}
	delete $sizecache{$self};
	delete $filecache{$self};
}

1;

Note that close and DESTROY are partially duplicates for the moment. I would probably complete the work by using a separate method based on the filename (after sync) called from close & destroy. The reason close is important is that it may be used while the object still exists and we want to know as close to closing time as possible.

ALSO NOTE - this captures the wrong size using "-s" as it is before the file is flushed - I can fix those problems easily later.

Right down to my questions:

1) Is there anyway of getting from a file handle:
    - That it is a file on disk, rather than Socket or Pipe
    - The filename of that file

2) What else would you change - in functions, calls and purpose to make this a useful CPAN module

3) Is there already something like this you know of?

I feel like I am going about this all wrong, but I am a little stuck and in need of help.

Thanks

Scott