Church, I have written a GUI using perl/tk that opens a popup window when anything is written to STDOUT or STDERR. However I did not have install privileges so I had to append the Tk::Stderr module to the end of the code (and hacked the STDOUT into it). It works, but I would like to flush (or empty) the stderr text array when the popup window is destroyed. Currently when it is reopened, the previous messages or errors are still in the text box. I am fuzzy on what exactly is happening in the code and haven't lucked upon any solution. Below is a minimized example. Thanks for any assistance. 
#!/usr/bin/perl

use warnings;
use strict;
use Tk;
# use Tk::Stderr; << ** pasted module after main ** - honyok

# create main window
my $mw = MainWindow->new;
$mw->InitStderr;
$mw->optionAdd("*font", "-*-calibri-normal-r-*-*-*-120-*-*-*-*-*-*");
$mw->protocol('WM_DELETE_WINDOW'=> sub{exit});
$mw->geometry( "100x100");
$mw->resizable(0,0);# not resizable
# create buttons
my $button1=$mw->Button(-text=>'STDERR',-command=>[sub{print STDERR "W
+riting to STDERR\n";}])->pack;
my $button2=$mw->Button(-text=>'STDOUT',-command=>[sub{print STDOUT "W
+riting to STDOUT\n";}])->pack;

MainLoop;
# =========================== end main ===============================
+===


##====================================================================
+==========
## Tk::Stderr - capture program standard error output
##====================================================================
+==========
## $Id: Stderr.pm,v 1.2 2003/04/01 03:58:42 kevin Exp $
##====================================================================
+==========
#require 5.006;
package Tk::Stderr;
use strict;
use warnings;
use vars qw($VERSION @ISA);
($VERSION) = q$Revision: 1.2 $ =~ /Revision:\s+(\S+)/ or $VERSION = "0
+.0";
use base qw(Tk::Derived Tk::MainWindow);

use Tk::ROText;
use Tk::Frame;

##====================================================================
+==========
## Populate
##====================================================================
+==========
sub Populate {
    my ($mw, $args) = @_;
    my $private = $mw->privateData;
    $private->{ReferenceCount} = 0;
    $private->{Enabled} = 0;

    $mw->SUPER::Populate($args);

    $mw->withdraw;
    $mw->protocol(WM_DELETE_WINDOW => [ $mw => 'withdraw']);
    my $f = $mw->Frame(
        Name => 'stderr_frame',
    )->pack(-fill => 'both', -expand => 1);

    my $text = $f->Scrolled(
        'ROText',
        Name => 'stderr_text',
        -scrollbars => 'se',
        -label=>'Output/Errors',
        -wrap => 'none'
        #-background=>'slate grey'
    )->pack(-fill => 'both', -expand => 1);
    
    $mw->Advertise('text' => $text);
    $mw->ConfigSpecs(
        '-title' => [ qw/METHOD title Title/, "truGrid" ],
    );

    $mw->Redirect(1);
    return $mw;
}

##====================================================================
+==========
## Redirect
##====================================================================
+==========
sub Redirect {

    my ($mw, $boolean) = @_;
    my $private = $mw->privateData;
    my $old = $private->{Enabled};
    
    if ($old && !$boolean) {
        untie *STDOUT;# ** hacked this line ** - honyok
        untie *STDERR;
        $SIG{__WARN__} = 'DEFAULT';
    } elsif (!$old && $boolean) {
        tie *STDOUT, 'Tk::Stderr::Handle', $mw;# ** hacked this line *
+* - honyok
        tie *STDERR, 'Tk::Stderr::Handle', $mw;
        $SIG{__WARN__} = sub { print STDOUT @_ };# ** hacked this line
+ ** - honyok
        $SIG{__WARN__} = sub { print STDERR @_ };
    }
    $private->{Enabled} = $boolean;
    return $old;
}


##====================================================================
+==========
## DecrementReferenceCount
##====================================================================
+==========
sub DecrementReferenceCount {
    my ($mw) = @_;
    my $private = $mw->privateData;

    if (--$private->{ReferenceCount} <= 0) {
        $mw->destroy;
    }
}

##====================================================================
+==========
## IncrementReferenceCount
##====================================================================
+==========
sub IncrementReferenceCount {
    my ($mw) = @_;
    my $private = $mw->privateData;

    ++$private->{ReferenceCount};
}


package MainWindow;
use strict;
use warnings;

my $error_window;

##====================================================================
+==========
## InitStderr
##====================================================================
+==========
sub InitStderr {
    my ($mw, $title) = @_;

    unless (defined $error_window) {
        $error_window = Tk::Stderr->new;
        $error_window->title($title) if defined $title;
    }
    $error_window->IncrementReferenceCount;
    $mw->OnDestroy([ 'DecrementReferenceCount' => $error_window ]);
    return $mw;
}

##====================================================================
+==========
## StderrWindow
##====================================================================
+==========
sub StderrWindow {
    return $error_window;
}

##====================================================================
+==========
## RedirectStderr
##====================================================================
+==========
sub RedirectStderr {
    my ($mw, $boolean) = @_;
    
    unless (defined $error_window) {
        $mw->InitStderr if $boolean;
        return;
    }
    return $error_window->Redirect($boolean);
}


##====================================================================
+==========
## Define the handle that actually implements things.
##====================================================================
+==========
BEGIN {
    package Tk::Stderr::Handle;
    use strict;
    use warnings;

    ##================================================================
+==========
    ## TIEHANDLE
    ##================================================================
+==========
    sub TIEHANDLE {
        my ($class, $window) = @_;
        bless \$window, $class;
    }

    ##================================================================
+==========
    ## PRINT
    ##================================================================
+==========
    sub PRINT {
        my $window = shift;
        my $text = $$window->Subwidget('text');
        $text->insert('end', $_) foreach (@_);
        $text->see('end');
        $$window->deiconify;
        $$window->raise;
        $$window->focus;
        $$window->update;# ** hacked this line ** - honyok
    }
    
    ##================================================================
+==========
    ## PRINTF
    ##================================================================
+==========
    sub PRINTF {
        my ($window, $format) = splice @_, 0, 2;

        $window->PRINT(sprintf $format, @_);
    }
}
1;
##====================================================================
+==========
## $Log: Stderr.pm,v $
## Revision 1.2  2003/04/01 03:58:42  kevin
## Add RedirectStderr method to allow redirection to be switched on an
+d off.
##
## Revision 1.1  2003/03/26 21:48:43  kevin
## Fix dependencies in Makefile.PL
##
## Revision 1.0  2003/03/26 19:11:32  kevin
## Initial revision
##====================================================================
+==========

[download]
questions are the engines of reason - epictetus

In reply to Tk::Stderr flush by honyok

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.