view release on metacpan or  search on metacpan

lib/clobber.pm  view on Meta::CPAN

package clobber;
use Carp;
use Fcntl;
use strict; no strict 'refs';
use vars '$VERSION'; $VERSION = 0.04;
eval "require Term::ReadKey";

sub unimport { #no strict 'refs';
  *{'CORE::GLOBAL::open'}    = \&OPEN    unless exists($^H{clobber});
  *{'CORE::GLOBAL::sysopen'} = \&SYSOPEN unless exists($^H{clobber});
  $^H{clobber} = $ENV{'clobber.pm'} || 0;
}

sub import {
  $^H{clobber} = 1;
}


sub OPEN(*;$@){
  my($handle, $mode, $file) = @_;
  my($testmode, $pipein) = $mode;

  if( scalar(@_) == 1 ){ #no strict 'refs';
    $mode = ${caller(1).'::'.$handle};
  }

  if( scalar(@_) == 2 ){
    #Convert 2-arg to 3-arg...
    #Initially tried to simply pass @_ through to CORE::open,
    #but it's prototype didn't like that

    #put into sub for /x, and easier "testing"?
    if( $mode =~ /^(\+?(?:>{1,2}|<)|(?:>&=?|<&=?|\|))?\s*(.+)\s*(\|)?$/ ){
      ($testmode, $file, $pipein) = ($1, $2, $3);
    }
    else{
      croak "Failed to parse EXPR of 2-arg open: $_[1]";
    }

    $testmode = $1 eq '|' ? '|-' : $1;
    unless( defined $testmode ){
      $testmode = $pipein ? '-|' : '>';
    }
  }
  elsif( scalar(@_) > 2 ){
    ($testmode, $file) = @_[1,2];
  }

  prompt($file) if -e $file && $testmode =~ /\+[<>](?!>)|^>(?!&|>)/;

  splice(@_, 0, 3);

  #no strict 'refs';
  CORE::open(*{caller(0) . '::' . $handle}, $testmode, $file, @_);
}

sub SYSOPEN(*$$;$){
  my($handle, $file, $mode, $perms) = @_;

  #We don't use O_EXCL because sysopen's failure is not trappable
  prompt($file) if -e $file && $mode&(O_WRONLY|O_RDWR|O_TRUNC);

  #no strict 'refs';
  CORE::sysopen(*{caller(0) . '::' . $handle}, $file, $mode, $perms||0666);
}

sub prompt{
  my $clobber = 0;

  return if (caller 1)[10]->{clobber};