Path: usenet.cis.ufl.edu!usenet.eel.ufl.edu!hookup!news.kei.com!simtel!news.sprintlink.net!psgrain!nntp.teleport.com!usenet
From: Bennett Todd <[email protected]>
Newsgroups: comp.lang.perl.announce,comp.lang.perl.misc,comp.lang.perl
Subject: Libbent: File.pm and Error.pm: OO File-I/O with error checking
Followup-To: comp.lang.perl.misc
Date: 15 Jul 1995 12:53:40 GMT
Organization: Mordor International BBS - Jersey City, NJ
Lines: 263
Approved: [email protected] (comp.lang.perl.announce)
Message-ID: <[email protected]>
NNTP-Posting-Host: linda.teleport.com
X-Disclaimer: The "Approved" header verifies header information for article transmission and does not imply approval of content.
Xref: usenet.cis.ufl.edu comp.lang.perl.announce:75 comp.lang.perl.misc:1772 comp.lang.perl:54391

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 protected]

#!/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 protected]>, with guidance and advice from Jeff Moore
       <[email protected]>

       =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

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.