I took another look , starting with Log::Log4perl::Appender::String docs was a mistake (misleading), should have looked only at Log::Log4perl::Appender
Here it is, with layout, you should probably run this by the log4perl support list for commentary
#!/usr/bin/perl --
use strict; use warnings;
use Tkx;
use Log::Log4perl; Log::Log4perl->easy_init( $Log::Log4perl::INFO );
Main( @ARGV );
exit( 0 );
sub Main {
#~ $Tkx::TRACE=64;
Tkx::package_require('tile');
Tkx::ttk__setTheme('xpnative');#Tkx::tile__setTheme('xpnative');
my $logger = Log::Log4perl->get_logger; ## jellisii2
my $appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::String2",
);
$appender->layout( ## jellisii2
Log::Log4perl::Layout::PatternLayout->new( "%d %m%n" ),
);
$logger->add_appender( $appender ); ## jellisii2
my $mw = Tkx::widget->new(".");
my $eee = $mw->new_entry(
-textvariable => $appender->string_ref, ## jellisii2
);
$eee->g_pack( -fill => "x", -expand => 1 );
my $t = $mw->new_text(
-padx => 5,
-pady => 5,
-background => "white",
);
$t->g_pack;
$appender->tktext( $t ); ## jellisii2
my $b = $mw->new_ttk__button(
-text => 'Hello, world',
-command => sub {
$logger->info("hi"); ## jellisii2
},
);
$b->g_pack;
$b->configure();
$logger->info("it begins"); ## jellisii2
Tkx::MainLoop();
}
BEGIN {
$INC{'Log/Log4perl/Appender/String2.pm'} = __FILE__;
package Log::Log4perl::Appender::String2;
use Log::Log4perl::Appender;
our @ISA = qw(Log::Log4perl::Appender);
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my %params = @_;
my $self = {
name => "unknown name",
string => "",
%params,
};
bless $self, $class;
}
sub log {
my( $self , %params ) = @_;
my $message = $params{message} ;
return unless $message;
if( my $status_text = $self->tktext ){
# text control has to be enabled to write to it.
$status_text->configure(-state => "normal");
$status_text->insert(
"end",
$message
);
$status_text->see("end");
# Don't want the user editing this...
$status_text->configure(-state => "disabled");
eval { $status_text->update(); 1} or eval { Tkx::update();
+ };
}
$self->{string} = "($message)";
}
sub string { # getter/setter
my($self, $new) = @_;
if(defined $new) {
$self->{string} = $new;
}
return $self->{string};
}
sub tktext { # getter/setter
my($self, $new) = @_;
if(defined $new) {
$self->{tktext} = $new;
}
return $self->{tktext};
}
sub string_ref { # getter
my($self ) = @_;
return \$self->{string};
}
1;
}
|