[FWP] Write-if-changed cleverness

[Bennett Todd <bet@newritz.mordor.net>]

What constitutes "fun" with perl? I suppose it's a matter of taste.

If you don't find this fun, by all means send me email to that effect and I'll
refrain from sharing such perversions in the future.

So what happened is, I wrote a really heroically un-fun bloated sweating
monster of a perl program; this thing currently weighs in at a bit over 21KB
of perl, nearly 500 lines, essentially none of it comments, reading a handful
of tables and mushing their bits this way and that, and spitting out a few
thousand odd text files, in dozens and dozens of different obscure formats,
with contents derived from those data tables. Then those text files are read
by a moderately expensively slow process, run thousands of times, which
updates some vector-graphics files which will then be presented on a static
web site. Re-write the static files quick enough and the fact that the site is
static (for performance) isn't obvious, as its content can reflect
more-or-less continuously updating changes. If you can do the rewrites quick
enough, that is. Thousands of invocations of that expensive graphical
converter thing isn't quick enough. Obviously, I need to stop doing the ones
that aren't changing anything. Problem is, figuring out which files actually
end up changing as a function of an edit to one of the input tables is obscure
enough to make my brain ache. So I came up with a hack. The perl part was
plenty fast enough, so I just interposed a little Fun, attached, and voila, a
script that was "rewriting" thousands of files actually only ended up writing
those that changed. I did this by inserting a new module, then doing a global
search-and-replace with IO::File with IO::Clever, but I expect if I were
sounder in my O-O I could have avoided even that. Here's IO::Clever, the one
part of this project I _really_ found fun:

	package IO::Clever;
	require 5.005_03;
	use strict;
	use vars qw($VERSION @ISA);
	@ISA = qw(IO::String);
	$VERSION = "1.00";

	my(%params,%str);

	sub new {
		my $class = shift;
		return IO::File->new(@_) unless $_[0] =~ /^>/;
		my $self = bless IO::String->new($str{$_[0]}), ref($class) || $class;
		$params{$self} = [ @_ ];
		$self;
	}

	sub DESTROY {
		my($self) = @_;
		my $filename = $params{$self}->[0];
		return unless $filename =~ s/^>//;
		my($new) = $str{$params{$self}->[0]};
		if (-f $filename) {
			my $fp = IO::File->new("<$filename") || die "$0: $filename: $!\n";
			$fp->input_record_separator(undef);
			return if $new eq $fp->getline;
		}
		my $fp = IO::File->new(@{$params{$self}}) || die;
		$fp->print($new);
	}

-Bennett

==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe