[Melbourne-pm] overloading 'print'

Mathew Robertson mathew.robertson at netratings.com.au
Tue Mar 21 14:56:56 PST 2006


Hi folks,

I asked the question of how to overload 'print' - here are the relevant 
parts of the implementation, for those that my be interested:

package MyPrint;
use strict;
use warnings;
use Symbol;
use Exporter;
use base qw(Exporter);
our $STDOUT;
our $filehandle;
our $print = 1;
our $println = 1;
our $this;

# Install a println handler to handle println'ing to a filehandle or STDOUT
sub IO::Handle::println { my $FH = shift; print $FH (@_,$/); }
sub main::println {  CORE::print (@_,$/); }

sub import {
  my $class = shift;
  my $caller = caller;
  my $sym = gensym;
  $STDOUT = select unless (defined $STDOUT);

  my %options;
  get_options('use',\%options, at _) if @_;
  $filehandle = (@_ > 0) ? shift : (defined $filehandle ? $filehandle : 
$STDOUT);
  die "Invalid filehandle specification" unless (defined $filehandle);

  $this = tie *$sym, $class, $filehandle;
  bless $sym, $class;

  if ($print) { select $sym; }
  if ($println) {  no strict 'refs';  *{$caller."::println"} = 
\&{$class."::LM_println"}; }

  return $class;
}

sub unimport {
  my $class = shift;
  my $caller = caller;
  if ($print) { select $STDOUT; }
  if ($println) { no strict 'refs';  *{$caller."::println"} = 
\&{$class."::CORE_println"}; }
  return $class;
}

sub TIEHANDLE {
  my $class = shift;
  my $self = bless {}, $class;
  if (@_ > 0) {
    $self->{fh} = shift or die "No filehandle specified in constructor.";
  } else {
    $self->{fh} = select;
  }
  return $self;
}

sub PRINT {
  my $self = shift;
  my $fh = *{ $self->{fh} };
  CORE::print $fh (mp(@_));
}

sub PRINTLN {
  my $self = shift;
  my $fh = *{ $self->{fh} };
  CORE::print $fh (mp(@_).$/);
}

no warnings 'once';
*new = *TIEHANDLE;
*print = *PRINT;
*println = *PRINTLN;
use warnings 'once';

sub CORE_println {  CORE::print $STDOUT @_,$/; }
sub LM_println {  PRINTLN $this, @_; }

sub mp { ...do funky stuff... }

1;

Thanks for all the suggestions,
Mathew


More information about the Melbourne-pm mailing list