Changing magic <> without changing core

Front page | perl.perl5.porters | Postings from July 2008

Changing magic <> without changing core

Thread Next

From:

Aaron Crane

Date:

July 27, 2008 13:10

Subject:

Changing magic <> without changing core

Message ID:

20080727201013.GA15254@aaroncrane.co.uk

For those who want the diamond operator to behave differently: it
seems (almost) possible to use a non-core, pure-Perl module to achieve
the desired effects.  I make no particular claims for the quality of
this code, but it seems to make all of the following work:

  use safe::open;
  while (<>) { print if /pattern/ }

  $ perl -Msafe::open -ne 'print if /pattern/'

  $ perl -Msafe::open -pe 's/pattern/replacement/g'

The approach is relatively simple: tie the ARGV handle when the module
is loaded, and provide a tied READLINE operator that does what's
desired.  In this case, I've gone for treating "-" as a synonym for
stdin, and everything else as the file of the appropriate name.
Failure to open a file is a fatal exception.

The only thing that doesn't seem to work at the moment is using -i
mode.  Does anyone know what incantations are needed to do that?  Is
it even possible?

If anyone wants to CPAN this code, they may do so with my blessing;
or maybe I'll be able to find some time to work on this over the next
week or two.  Conspicuous by their absence from my current version
are documentation, tests, and implementations of the other input
operators, including READ and GETC.

  package safe::open;

  use strict;
  use warnings;

  use Carp qw<croak>;

  tie *::ARGV, __PACKAGE__;

  sub TIEHANDLE {
      my ($class) = @_;
      my @args = @::ARGV;
      @args = '-' if !@args;
      return bless {
          args => \@args,
          fh   => undef,
      }, $class;
  }

  sub READLINE {
      my ($self) = @_;
      return wantarray ? $self->read_many_lines : $self->read_one_line;
  }

  sub read_one_line {
      my ($self) = @_;
      while (1) {
          my $fh = $self->{fh} || $self->open_next_file or return;
          my $line = <$fh>;
          return $line if defined $line;
          $self->{fh} = undef;
      }
  }

  sub read_many_lines {
      my ($self) = @_;
      my @lines;
      while (1) {
          my $fh = $self->{fh} || $self->open_next_file or return @lines;
          push @lines, <$fh>;
          $self->{fh} = undef;
      }
  }

  sub open_next_file {
      my ($self) = @_;
      if (!@{ $self->{args} }) {
          $self->{fh} = undef;
          return;
      }
      my $file = shift @{ $self->{args} };
      return \*STDIN if $file eq '-';
      open my $fh, '<', $file or croak "Can't open $file for reading: $!";
      return $self->{fh} = $fh;
  }

  1;

-- 
Aaron Crane ** http://aaroncrane.co.uk/

Thread Next