FileHandle 0.03, New Modules:
This is the first part of the FileHandle patches I posted a long
time ago, in a galaxy far, far away.
New modules:
FileCache:
Splits out the "cacheout" functionality from FileHandle,
where it never really belonged.
Symbol:
Encapsulates the creation of anonymous globs.
You can say "Symbol::generate" for a plain glob, or
"new Symbol" for one blessed into the "Symbol" package.
DirHandle:
All the usual object-encapsulation tricks for the directory
functions.
SelectSaver:
Creating a SelectSaver object saves the currently selected
output handle. Its destruction automatically restores the
saved handle. Thus you can avoid explicit restoration,
simplifying code, and you'll never accidentally forget it.
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1995-10-15 17:31 EDT by <chip@fin>.
# Source directory was `/u/src/cmd/perl-5.001m'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 1356 -r--r--r-- lib/DirHandle.pm
# 1655 -r--r--r-- lib/FileCache.pm
# 841 -r--r--r-- lib/SelectSaver.pm
# 1159 -r--r--r-- lib/Symbol.pm
#
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
shar_touch=touch
else
shar_touch=:
echo
echo 'WARNING: not restoring timestamps. Consider getting and'
echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 1231235999 $$.touch
#
# ============= lib/DirHandle.pm ==============
if test ! -d 'lib'; then
echo 'x - creating directory lib'
mkdir 'lib'
fi
if test -f 'lib/DirHandle.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/DirHandle.pm (file already exists)'
else
echo 'x - extracting lib/DirHandle.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/DirHandle.pm' &&
package DirHandle;
X
=head1 NAME
X
DirHandle - supply object methods for directory handles
X
=head1 SYNOPSIS
X
X use DirHandle;
X $d = new DirHandle ".";
X if (defined $d) {
X while (defined($_ = $d->read)) { something($_); }
X $d->rewind;
X while (defined($_ = $d->read)) { something_else($_); }
X undef $d;
X }
X
=head1 DESCRIPTION
X
The C<DirHandle> method provide an alternative interface to the
opendir(), closedir(), readdir(), and rewinddir() functions.
X
The only objective benefit to using C<DirHandle> is that it avoids
namespace pollution by creating globs to hold directory handles.
X
=cut
X
require 5.000;
use Carp;
use Symbol;
X
sub new {
X croak 'usage: new DirHandle [DIRNAME]' unless @_ >= 1 && @_ <= 2;
X my $dh = Symbol::generate;
X if (@_ > 1) {
X DirHandle::open($dh, $_[1])
X or return undef;
X }
X bless $dh;
}
X
sub DESTROY {
X my ($dh) = @_;
X closedir($dh);
}
X
sub open {
X croak 'usage: $dh->open(DIRNAME)' unless @_ == 2;
X my ($dh, $dirname) = @_;
X opendir($dh, $dirname);
}
X
sub close {
X croak 'usage: $dh->close()' unless @_ == 1;
X my ($dh) = @_;
X closedir($dh);
}
X
sub read {
X croak 'usage: $dh->read()' unless @_ == 1;
X my ($dh) = @_;
X readdir($dh);
}
X
sub rewind {
X croak 'usage: $dh->rewind()' unless @_ == 1;
X my ($dh) = @_;
X rewinddir($dh);
}
X
1;
SHAR_EOF
$shar_touch -am 1015162195 'lib/DirHandle.pm' &&
chmod 0444 'lib/DirHandle.pm' ||
echo 'restore of lib/DirHandle.pm failed'
shar_count="`wc -c < 'lib/DirHandle.pm'`"
test 1356 -eq "$shar_count" ||
echo "lib/DirHandle.pm: original size 1356, current size $shar_count"
fi
# ============= lib/FileCache.pm ==============
if test -f 'lib/FileCache.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/FileCache.pm (file already exists)'
else
echo 'x - extracting lib/FileCache.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/FileCache.pm' &&
package FileCache;
X
=head1 NAME
X
FileCache - keep more files open than the system permits
X
=head1 SYNOPSIS
X
X cacheout $path;
X print $path @data;
X
=head1 DESCRIPTION
X
The C<cacheout> function will make sure that there's a filehandle open
for writing available as the pathname you give it. It automatically
closes and re-opens files if you exceed your system file descriptor
maximum.
X
=head1 BUGS
X
F<sys/param.h> lies with its C<NOFILE> define on some systems,
so you may have to set $cacheout::maxopen yourself.
X
=cut
X
require 5.000;
use Carp;
use Exporter;
X
@ISA = qw(Exporter);
@EXPORT = qw(
X cacheout
);
X
# Open in their package.
X
sub cacheout_open {
X my $pack = caller(1);
X open(*{$pack . '::' . $_[0]}, $_[1]);
}
X
sub cacheout_close {
X my $pack = caller(1);
X close(*{$pack . '::' . $_[0]});
}
X
# But only this sub name is visible to them.
X
$cacheout_seq = 0;
$cacheout_numopen = 0;
X
sub cacheout {
X ($file) = @_;
X unless (defined $cacheout_maxopen) {
X if (open(PARAM,'/usr/include/sys/param.h')) {
X local $.;
X while (<PARAM>) {
X $cacheout_maxopen = $1 - 4
X if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
X }
X close PARAM;
X }
X $cacheout_maxopen = 16 unless $cacheout_maxopen;
X }
X if (!$isopen{$file}) {
X if (++$cacheout_numopen > $cacheout_maxopen) {
X my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
X splice(@lru, $cacheout_maxopen / 3);
X $cacheout_numopen -= @lru;
X for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
X }
X cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
X or croak("Can't create $file: $!");
X }
X $isopen{$file} = ++$cacheout_seq;
}
X
1;
SHAR_EOF
$shar_touch -am 1015154195 'lib/FileCache.pm' &&
chmod 0444 'lib/FileCache.pm' ||
echo 'restore of lib/FileCache.pm failed'
shar_count="`wc -c < 'lib/FileCache.pm'`"
test 1655 -eq "$shar_count" ||
echo "lib/FileCache.pm: original size 1655, current size $shar_count"
fi
# ============= lib/SelectSaver.pm ==============
if test -f 'lib/SelectSaver.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/SelectSaver.pm (file already exists)'
else
echo 'x - extracting lib/SelectSaver.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/SelectSaver.pm' &&
package SelectSaver;
X
=head1 NAME
X
SelectSaver - save and restore selected file handle
X
=head1 SYNOPSIS
X
X use SelectSaver;
X
X {
X my $saver = new SelectSaver(FILEHANDLE);
X # FILEHANDLE is selected
X }
X # previous handle is selected
X
=head1 DESCRIPTION
X
A C<SelectSaver> object contains a reference to the file handle that
was selected when it was created. If its C<new> method gets an extra
parameter, then that parameter is selected; otherwise, the selected
file handle remains unchanged.
X
When a C<SelectSaver> is destroyed, it re-selects the file handle
that was selected when it was created.
X
=cut
X
require 5.000;
use Carp;
X
sub new {
X croak "usage: new SelectSaver [FILEHANDLE]" unless @_ && @_ <= 2;
X my $fh = select @_[1 .. $#_];
X bless \$fh;
}
X
sub DESTROY {
X my $fh = $_[0];
X select $$fh;
}
X
1;
SHAR_EOF
$shar_touch -am 0920232395 'lib/SelectSaver.pm' &&
chmod 0444 'lib/SelectSaver.pm' ||
echo 'restore of lib/SelectSaver.pm failed'
shar_count="`wc -c < 'lib/SelectSaver.pm'`"
test 841 -eq "$shar_count" ||
echo "lib/SelectSaver.pm: original size 841, current size $shar_count"
fi
# ============= lib/Symbol.pm ==============
if test -f 'lib/Symbol.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/Symbol.pm (file already exists)'
else
echo 'x - extracting lib/Symbol.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/Symbol.pm' &&
package Symbol;
X
=head1 NAME
X
Symbol - create and destroy symbols for use as "anonymous" handles
X
=head1 SYNOPSIS
X
X use Symbol;
X
X # USAGE #1: BLESSED GLOB REFERENCE
X $g = new Symbol;
X open($g, "foo");
X # ...
X close($g);
X undef $g;
X
X # USAGE #2: SIMPLE GLOB REFERENCE
X $g = Symbol::generate;
X open($g, "foo");
X print <$g>;
X close($g);
X undef $g;
X
=head1 DESCRIPTION
X
A C<Symbol> object is a reference to a glob that is, for all practical
purposes, anonymous. In fact it has a name, but it doesn't actually
exist in the symbol table where it was originally created, so it
cannot be accessed by name, only by reference.
X
If blessing the glob reference into the C<Symbol> package is not
desired -- such as for the C<FileHandle> methods in the C<POSIX>
package -- then the function C<Symbol::generate> may be used.
X
=cut
X
require 5.000;
use Carp;
X
sub generate;
X
sub new {
X bless generate;
}
X
sub DESTROY {
}
X
$count = 0;
X
sub generate {
X my $name = "S" . ++$count;
X local *{$name};
X \delete $Symbol::{$name};
}
X
sub isa {
X my ($sym) = @_;
X ref($sym) =~ /GLOB\(/
X and ("".$$sym) =~ /Symbol::S/;
}
X
1;
SHAR_EOF
$shar_touch -am 1015160795 'lib/Symbol.pm' &&
chmod 0444 'lib/Symbol.pm' ||
echo 'restore of lib/Symbol.pm failed'
shar_count="`wc -c < 'lib/Symbol.pm'`"
test 1159 -eq "$shar_count" ||
echo "lib/Symbol.pm: original size 1159, current size $shar_count"
fi
exit 0
This is the first part of the FileHandle patches I posted a long
time ago, in a galaxy far, far away.
New modules:
FileCache:
Splits out the "cacheout" functionality from FileHandle,
where it never really belonged.
Symbol:
Encapsulates the creation of anonymous globs.
You can say "Symbol::generate" for a plain glob, or
"new Symbol" for one blessed into the "Symbol" package.
DirHandle:
All the usual object-encapsulation tricks for the directory
functions.
SelectSaver:
Creating a SelectSaver object saves the currently selected
output handle. Its destruction automatically restores the
saved handle. Thus you can avoid explicit restoration,
simplifying code, and you'll never accidentally forget it.
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1995-10-15 17:31 EDT by <chip@fin>.
# Source directory was `/u/src/cmd/perl-5.001m'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 1356 -r--r--r-- lib/DirHandle.pm
# 1655 -r--r--r-- lib/FileCache.pm
# 841 -r--r--r-- lib/SelectSaver.pm
# 1159 -r--r--r-- lib/Symbol.pm
#
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
shar_touch=touch
else
shar_touch=:
echo
echo 'WARNING: not restoring timestamps. Consider getting and'
echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 1231235999 $$.touch
#
# ============= lib/DirHandle.pm ==============
if test ! -d 'lib'; then
echo 'x - creating directory lib'
mkdir 'lib'
fi
if test -f 'lib/DirHandle.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/DirHandle.pm (file already exists)'
else
echo 'x - extracting lib/DirHandle.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/DirHandle.pm' &&
package DirHandle;
X
=head1 NAME
X
DirHandle - supply object methods for directory handles
X
=head1 SYNOPSIS
X
X use DirHandle;
X $d = new DirHandle ".";
X if (defined $d) {
X while (defined($_ = $d->read)) { something($_); }
X $d->rewind;
X while (defined($_ = $d->read)) { something_else($_); }
X undef $d;
X }
X
=head1 DESCRIPTION
X
The C<DirHandle> method provide an alternative interface to the
opendir(), closedir(), readdir(), and rewinddir() functions.
X
The only objective benefit to using C<DirHandle> is that it avoids
namespace pollution by creating globs to hold directory handles.
X
=cut
X
require 5.000;
use Carp;
use Symbol;
X
sub new {
X croak 'usage: new DirHandle [DIRNAME]' unless @_ >= 1 && @_ <= 2;
X my $dh = Symbol::generate;
X if (@_ > 1) {
X DirHandle::open($dh, $_[1])
X or return undef;
X }
X bless $dh;
}
X
sub DESTROY {
X my ($dh) = @_;
X closedir($dh);
}
X
sub open {
X croak 'usage: $dh->open(DIRNAME)' unless @_ == 2;
X my ($dh, $dirname) = @_;
X opendir($dh, $dirname);
}
X
sub close {
X croak 'usage: $dh->close()' unless @_ == 1;
X my ($dh) = @_;
X closedir($dh);
}
X
sub read {
X croak 'usage: $dh->read()' unless @_ == 1;
X my ($dh) = @_;
X readdir($dh);
}
X
sub rewind {
X croak 'usage: $dh->rewind()' unless @_ == 1;
X my ($dh) = @_;
X rewinddir($dh);
}
X
1;
SHAR_EOF
$shar_touch -am 1015162195 'lib/DirHandle.pm' &&
chmod 0444 'lib/DirHandle.pm' ||
echo 'restore of lib/DirHandle.pm failed'
shar_count="`wc -c < 'lib/DirHandle.pm'`"
test 1356 -eq "$shar_count" ||
echo "lib/DirHandle.pm: original size 1356, current size $shar_count"
fi
# ============= lib/FileCache.pm ==============
if test -f 'lib/FileCache.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/FileCache.pm (file already exists)'
else
echo 'x - extracting lib/FileCache.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/FileCache.pm' &&
package FileCache;
X
=head1 NAME
X
FileCache - keep more files open than the system permits
X
=head1 SYNOPSIS
X
X cacheout $path;
X print $path @data;
X
=head1 DESCRIPTION
X
The C<cacheout> function will make sure that there's a filehandle open
for writing available as the pathname you give it. It automatically
closes and re-opens files if you exceed your system file descriptor
maximum.
X
=head1 BUGS
X
F<sys/param.h> lies with its C<NOFILE> define on some systems,
so you may have to set $cacheout::maxopen yourself.
X
=cut
X
require 5.000;
use Carp;
use Exporter;
X
@ISA = qw(Exporter);
@EXPORT = qw(
X cacheout
);
X
# Open in their package.
X
sub cacheout_open {
X my $pack = caller(1);
X open(*{$pack . '::' . $_[0]}, $_[1]);
}
X
sub cacheout_close {
X my $pack = caller(1);
X close(*{$pack . '::' . $_[0]});
}
X
# But only this sub name is visible to them.
X
$cacheout_seq = 0;
$cacheout_numopen = 0;
X
sub cacheout {
X ($file) = @_;
X unless (defined $cacheout_maxopen) {
X if (open(PARAM,'/usr/include/sys/param.h')) {
X local $.;
X while (<PARAM>) {
X $cacheout_maxopen = $1 - 4
X if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
X }
X close PARAM;
X }
X $cacheout_maxopen = 16 unless $cacheout_maxopen;
X }
X if (!$isopen{$file}) {
X if (++$cacheout_numopen > $cacheout_maxopen) {
X my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
X splice(@lru, $cacheout_maxopen / 3);
X $cacheout_numopen -= @lru;
X for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
X }
X cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
X or croak("Can't create $file: $!");
X }
X $isopen{$file} = ++$cacheout_seq;
}
X
1;
SHAR_EOF
$shar_touch -am 1015154195 'lib/FileCache.pm' &&
chmod 0444 'lib/FileCache.pm' ||
echo 'restore of lib/FileCache.pm failed'
shar_count="`wc -c < 'lib/FileCache.pm'`"
test 1655 -eq "$shar_count" ||
echo "lib/FileCache.pm: original size 1655, current size $shar_count"
fi
# ============= lib/SelectSaver.pm ==============
if test -f 'lib/SelectSaver.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/SelectSaver.pm (file already exists)'
else
echo 'x - extracting lib/SelectSaver.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/SelectSaver.pm' &&
package SelectSaver;
X
=head1 NAME
X
SelectSaver - save and restore selected file handle
X
=head1 SYNOPSIS
X
X use SelectSaver;
X
X {
X my $saver = new SelectSaver(FILEHANDLE);
X # FILEHANDLE is selected
X }
X # previous handle is selected
X
=head1 DESCRIPTION
X
A C<SelectSaver> object contains a reference to the file handle that
was selected when it was created. If its C<new> method gets an extra
parameter, then that parameter is selected; otherwise, the selected
file handle remains unchanged.
X
When a C<SelectSaver> is destroyed, it re-selects the file handle
that was selected when it was created.
X
=cut
X
require 5.000;
use Carp;
X
sub new {
X croak "usage: new SelectSaver [FILEHANDLE]" unless @_ && @_ <= 2;
X my $fh = select @_[1 .. $#_];
X bless \$fh;
}
X
sub DESTROY {
X my $fh = $_[0];
X select $$fh;
}
X
1;
SHAR_EOF
$shar_touch -am 0920232395 'lib/SelectSaver.pm' &&
chmod 0444 'lib/SelectSaver.pm' ||
echo 'restore of lib/SelectSaver.pm failed'
shar_count="`wc -c < 'lib/SelectSaver.pm'`"
test 841 -eq "$shar_count" ||
echo "lib/SelectSaver.pm: original size 841, current size $shar_count"
fi
# ============= lib/Symbol.pm ==============
if test -f 'lib/Symbol.pm' && test X"$1" != X"-c"; then
echo 'x - skipping lib/Symbol.pm (file already exists)'
else
echo 'x - extracting lib/Symbol.pm (text)'
sed 's/^X//' << 'SHAR_EOF' > 'lib/Symbol.pm' &&
package Symbol;
X
=head1 NAME
X
Symbol - create and destroy symbols for use as "anonymous" handles
X
=head1 SYNOPSIS
X
X use Symbol;
X
X # USAGE #1: BLESSED GLOB REFERENCE
X $g = new Symbol;
X open($g, "foo");
X # ...
X close($g);
X undef $g;
X
X # USAGE #2: SIMPLE GLOB REFERENCE
X $g = Symbol::generate;
X open($g, "foo");
X print <$g>;
X close($g);
X undef $g;
X
=head1 DESCRIPTION
X
A C<Symbol> object is a reference to a glob that is, for all practical
purposes, anonymous. In fact it has a name, but it doesn't actually
exist in the symbol table where it was originally created, so it
cannot be accessed by name, only by reference.
X
If blessing the glob reference into the C<Symbol> package is not
desired -- such as for the C<FileHandle> methods in the C<POSIX>
package -- then the function C<Symbol::generate> may be used.
X
=cut
X
require 5.000;
use Carp;
X
sub generate;
X
sub new {
X bless generate;
}
X
sub DESTROY {
}
X
$count = 0;
X
sub generate {
X my $name = "S" . ++$count;
X local *{$name};
X \delete $Symbol::{$name};
}
X
sub isa {
X my ($sym) = @_;
X ref($sym) =~ /GLOB\(/
X and ("".$$sym) =~ /Symbol::S/;
}
X
1;
SHAR_EOF
$shar_touch -am 1015160795 'lib/Symbol.pm' &&
chmod 0444 'lib/Symbol.pm' ||
echo 'restore of lib/Symbol.pm failed'
shar_count="`wc -c < 'lib/Symbol.pm'`"
test 1159 -eq "$shar_count" ||
echo "lib/Symbol.pm: original size 1159, current size $shar_count"
fi
exit 0