PerlIO::via::trap - PerlIO layer to trap write

PerlIO-via-trap documentation Contained in the PerlIO-via-trap distribution.

Index

Code Index:

NAME

Top

PerlIO::via::trap - PerlIO layer to trap write

SYNOPSIS

Top

 use PerlIO::via::trap;

 open( my $in,'<:via(trap)','file.txt' );	# no effect
 open( my $out,'>:via(trap)','file.txt' );	# write will cause confess

 use PerlIO::via::trap ('open');		# auto trap

 $PerlIO::via::trap::PASS = 1;			# disable trap

DESCRIPTION

Top

This module implements a PerlIO layer that captures attemps to write to files. This is especially useful for debugging modules that are corrupting files.

CAVEATS

Top

Note that the PERLIO environment variable does not work with :via modules, so you need to override core::open if you don't want to change the modules are you trying to fix.

SEE ALSO

Top

PerlIO::via

AUTHORS

Top

Chia-liang Kao <clkao@clkao.org>

COPYRIGHT

Top

Copyright 2002 by Chia-liang Kao <clkao@clkao.org>.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

PerlIO-via-trap documentation Contained in the PerlIO-via-trap distribution. 
package PerlIO::via::trap;
require Exporter;
@ISA = 'Exporter';
@EXPORT = 'open';
$VERSION = '0.09';

use strict;
use Carp;
use IO::Handle;

our $PASS = 0;

sub PUSHED { bless \*PUSHED,$_[0] }
sub FILL { readline( $_[1] ) }

sub SEEK {
    seek $_[3], $_[1], $_[2];
    return 0;
} #SEEK

sub WRITE {
    my ($obj, $buf, $fh) = @_;
    confess "attempt to write ".length($_[1])."bytes to $_[2]" unless $PASS;
    $fh->print($buf);
} #WRITE

sub import {
    my $pkg = shift;
    return unless @_;
    my $sym = shift;
    $pkg->export('CORE::GLOBAL', $sym, @_);
}

sub open (*;@) {
    no strict 'refs';
    my $fh = $_[0] ? *{caller()."::$_[0]"} : $_[0];
    my ($mode, $file) = @_[1,2];

    unless (defined $file) {
	($mode, $file) = ($mode =~ /^(\+?(?:<|>>?|\|)?)(.+)$/);
	# XXX: should we take care of > here to avoid truncation?
	$mode ||= '<';
    }

    my $ret = CORE::open($fh, $mode, $file);
    binmode $fh, ':via(trap)';
    $_[0] ||= $fh;
    $ret;
}

1;
__END__