[Nottingham-pm] tied filehandle - how to get the filehandle from the PRINT method?

Michael Erskine msemtd at yahoo.co.uk
Thu Nov 2 07:39:46 PST 2006


On Thursday 02 November 2006 12:12, Michael Erskine wrote:
> Thanks Duncan but I've just come across
> http://search.cpan.org/~reynolds/IO-Capture-0.05/ which contains
> IO::Capture::Stderr and IO::Capture::Stdout which are a better way of
> achieving my fancy-ass hack.

Even better, I've just got my head around tie and made a little package that 
is custom to my Tk needs...

#!/usr/bin/perl -w
use strict;
use Tk; 
use Tk::Text; 
use Tk::ErrorDialog;
package grabber; 
sub TIEHANDLE { 
    my ($class,$textwidget, $tag) = @_; 
    return bless {textwidget => $textwidget, tag => $tag}, $class; 
}
sub PRINTF{
    my $w = shift;
    $w->PRINT(sprintf(shift, at _));
}
sub PRINT { 
    my $obj = shift; 
    my $tag = $obj->{tag};
    my $w = $obj->{textwidget}; 
    while (@_) { 
        $w->insert('end',shift, $tag); 
    } 
    $w->see('end'); 
} 
package main; 
my $mw = new MainWindow(); 
my $tw = $mw->Text()->pack(); 
$tw->tagConfigure("stdout", -foreground => 'green'); 
$tw->tagConfigure("stderr", -foreground => 'pink', -background 
=> 'red', -relief => 'raised', -borderwidth => 3); 
$mw->Button(-text => 'tie stdout', -command => sub { tie *STDOUT, 'grabber', 
$tw, 'stdout' })->pack(); 
$mw->Button(-text => 'tie stderr', -command => sub { tie *STDERR, 'grabber', 
$tw, 'stderr' })->pack(); 
$mw->Button(-text => 'talk stdout', -command => sub { print STDOUT 
scalar(localtime).": Hello stdout!\n";})->pack(); 
$mw->Button(-text => 'warn', -command => sub { warn scalar(localtime).
": Hello warning!\n";})->pack();
$mw->Button(-text => 'die', -command => sub { die scalar(localtime).
": Hello death!\n";})->pack();
MainLoop; 

Regards,
Michael Erskine.

-- 
Many pages make a thick book.

Send instant messages to your online friends http://uk.messenger.yahoo.com 


More information about the Nottingham-pm mailing list