Subject: Libbent: File.pm and Error.pm: OO File-I/O with error checking
From: Bennett Todd <[email-masked]>
Date: 15 Jul 1995 12:53:40 GMT
Newsgroups: comp.lang.perl.announce,comp.lang.perl.misc,comp.lang.perl

I've recently started hacking up a utility library. My starting point is the
same place I started when I did my C utility library libbent, lo these many
years ago; I noticed some idioms that were getting tiresome, I was doing them
so often. It's gotten complete enough to start doing some useful things.

	$src = Libbent::File::new "<src";
	$dst = Libbent::File::new ">dst";
	while ($_ = $src->Read) {
		$dst->Print($_);
	}
	# The above loop could be replaced by:
	#	$dst->Print($src->Read);
	# using the chomp-a-whole-file-in-array-context trick

The above style of I/O, using this library, checks for errors on every
operation. There's also a debugging flag that traces the method invocations; I
find this a useful way to get a quick feel for what a large program is doing.

-Bennett
[email-masked]

#!/bin/sh
# To unpack this Shell Archive, save this into a file, edit it deleting everything
# before the above ``#!/bin/sh'' line, and run the command ``sh filename''.
test -d 'Libbent' || (
	echo x - 'Libbent'/
	mkdir 'Libbent'
)
cd 'Libbent'
echo x - 'Libbent/File.pm'
sed 's/^	//' <<'EOF' >'File.pm'
	package Libbent::File; # Version 1.0
	require Exporter;
	@ISA = qw(Exporter);
	use Libbent::Error qw(Error);
	
	=head1 NAME
	
	File --- vaguely OO File I/O
	
	=head1 SYNOPSIS
	
	    use Libbent::File;
	    $file = Libbent::File::new(">filename");
	    $line = $file->Read();
	    @wholefile = $file->Read();
	    $block = $file->Read($blocksize);
	    $file-Print($some_output);
	
	=head1 DESCRIPTION
	
	This package is designed to address various wishes I have for I/O.
	
	It provides interface routines that don't need to explicitly be checked for
	errors; if an error occurs they will exit with a suitable message. On those
	occasions where you want to catch an error and deal with it explicitly (rare,
	in my experience) you can just replace a call like (e.g.)
	
		$file = Libbent::File::new(">filename");
	
	with
	
		$file = eval { Libbent::File::new(">filename"); };
	
	and then check $file to see if it's undef; if it is, then the message that
	Open would have died with will be found in $@.
	
	It performs another task: handles, as returned by File::new, are simple
	scalars, and so can be localized with my(), and otherwise treated like normal
	objects.
	
	=head1 FUNCTIONS
	
	=over 4
	
	=cut
	
	=item new filename
	
	C<new> creates new File handles. It takes file and/or command arguments in the
	same syntax as Perl's open(), with leading "<" for file read, ">" for file
	write, "|" for pipe, and so on. It returns the handle.
	
	=cut
	
	sub new {
		my($arg) = @_; my($self) = {}; &debug($self, @_);
		($self->{'name'} = $arg) =~ s/^[<>]//;
		my($seq) = '000000';
		$seq++ while exists $handle{$arg . $seq};
		$self->{'handle'} = $arg . $seq;
		$handle{$self->{'handle'}}++;
		open $self->{'handle'}, $arg or Error 'open', $self->{'name'};
		bless $self;
	}
	
	=item Read [n]
	
	C<Read> is the input method. If no count is specified it behaves like Perl's
	C<<>> input operator, including sensitivity to scalar or array context. If
	C<n> is specified, then it uses perl's C<read> procedure, returning the
	bufferfull of data.
	
	=cut
	
	sub Read {
		my($self, $n) = @_; &debug(@_);
		my($handle) = $self->{'handle'};
		if (defined($n)) {
			my($buff);
			defined(read($handle, $buff, $n)) or
				Error 'read', $self->{'name'};
			return $buff;
		}
		if (wantarray) {
			my(@ret);
			defined(@ret = <$handle>) or
				Error 'read', $self->{'name'};
			return(@ret);
		} else {
			my($ret);
			defined($ret = <$handle>) or
				Error 'read', $self->{'name'};
			return($ret);
		}
	}

	=item Print stuff
	
	C<Print> behaves exactly like perl's C<print>, except of course for trapping
	errors.
	
	=cut
	
	sub Print {
		my($self, @args) = @_; &debug(@_);
		my($handle) = $self->{'handle'};
		print $handle @args or Error 'print', $self->{'name'};
	}
	
	=item DESTROY
	
	The DESTROY procedure doesn't need to be explicitly called; Perl handles that
	for you when the last reference to the file handle is lost. The DESTROY method
	closes the filehandle and cleans up internal data structures. The implication
	of this is that C<close> can be forced by C<undef>-ing your reference to the
	handle.
	
	=cut
	
	sub DESTROY {
		my($self) = @_; &debug(@_);
		close $self->{'handle'};
		delete $handle_exists{$self->{'handle'}};
	}
	
	=item Debug [n]
	
	C<Debug> turns debugging on or off, either class-wide for for specific
	handles. Specifically:
	
		Libbent::File->Debug 1;		# Turns on debugging class-wide
		Libbent::File->Debug 0;		# Turns it back off, class-wide
		$file->Debug 1;			# Overrides the class default
	
	=cut
	
	$debug = 0;
	$debug_file = 'STDERR';
	
	sub Debug {
		my($what, $value) = @_;
		if (defined($value)) {
			if (ref $what) {
				$what->{'debug'} = $value;
			} else {
				$debug = $value;
			}
		} else {
			if (ref $what and exists $what->{'debug'}) {
				return $what->{'debug'};
			} else {
				return $debug;
			}
		}
	}
	
	sub debug {
		my($self, @args) = @_;
	
		return unless $self->{'debug'} or $debug;
		my($subr) = (caller(1))[3];
		$subr =~ s/^.*:://;
		my(@toprint) = grep {defined $_} $subr, $self->{'name'}, @args;
		print $debug_file join(' ', @toprint), "\n";
	}
	
	=back
	
	=head1 SEE ALSO
	
	Libbent::Error, which this class uses
	
	=head1 AUTHOR
	
	Bennett Todd <[email-masked]>, with guidance and advice from Jeff Moore
	<[email-masked]>
	
	=cut
EOF
echo x - 'Libbent/Error.pm'
sed 's/^	//' <<'EOF' >'Error.pm'
	package Libbent::Error; # Version 1.0
	require Exporter;
	@ISA = qw(Exporter);
	@EXPORT_OK = qw(Error);
	use File::Basename;
	
	=head1 NAME
	
	Error -- die with suitable error message
	
	=head1 SYNOPSIS
	
	    use Libbent::Error qw(Error);
	    try something or Error "what I tried";
	
	=cut
	
	sub Error {
		die join(': ',
			basename($main::0),
			join(' ', grep { defined $_ } @_),
			$!
		    ) . "\n";
	}
EOF
echo x - 'Libbent/cat'
sed 's/^	//' <<'EOF' >'cat'
	#!/usr/local/bin/perl5 -w # Version 1.0
	BEGIN { unshift @INC, $ENV{'HOME'} . '/lib/perl'; }
	use File::Basename;
	use Getopt::Std;
	use Libbent::File;
	
	$progname = basename($0);
	$syntax = "syntax: $progname [-d] [file ...]\n";
	$opt_d = 0;
	getopts 'd' or die $syntax;
	Libbent::File->Debug(1) if $opt_d;
	unshift @ARGV, '&STDIN' unless @ARGV;
	
	$out = Libbent::File::new '>&STDOUT';
	
	foreach (@ARGV) {
		$out->Print(Libbent::File::new("<$_")->Read());
	}
EOF
chmod a+x 'cat'
cd ..
exit 0