| Log-Dispatch-Tk documentation | Contained in the Log-Dispatch-Tk distribution. |
Log::Dispatch::ToTk - Class to redirect Log::Dispatch to Tk widgets
# Log::Dispatch::ToTk must be used in a composite widget
Tk::Widget->Construct('LogText');
sub InitObject
{
my ($dw,$args) = @_ ;
# retrieve parameters specific to Log::Dispatch::*
my %params ;
foreach my $key (qw/name min_level max_level/)
{
$params{$key} = delete $args->{$key}
if defined $args->{$key};
}
# create the TkTk buddy class
$dw->{logger} = Log::Dispatch::ToTk->
new(%params, widget => $dw) ;
# initiaze the widget
$dw->SUPER::InitObject($args) ;
}
# mandatory method in Tk widget using Log::Dispatch::ToTk
sub logger
{
my $dw = shift;
return $dw->{logger} ;
}
__END__
Most users will only need to use Log::Dispatch::TkText widget to have Log::Dispatch messages written on a text widget.
For more fancy uses, this module can be used by a composite widget dedicated to handle Log::Dispatch logs.
This module is the interface class between Log::Dispatch and Tk widgets. This class is derived from Log::Dispatch::Output.
One ToTk object will be created for each Log::Dispatch::Tk* widget and the user must register the ToTk object to the log dispatcher.
Create a new ToTk object. Parameter are :
The buddy widget object
The name of the object (not the filename!). Required.
The minimum logging level this object will accept. See the Log::Dispatch documentation for more information. Required.
The maximum logging level this obejct will accept. See the Log::Dispatch documentation for more information. This is not required. By default the maximum is the highest possible level (which means functionally that the object has no maximum).
Sends a message if the level is greater than or equal to the object's minimum level.
Dominique Dumont <Dominique.Dumont@hp.com> using Log::Dispatch and Log::Dispatch::Output from Dave Rolsky, autarch@urth.org
Copyright (c) 2000, 2003 Hewlett-Packard Company. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Log-Dispatch-Tk documentation | Contained in the Log-Dispatch-Tk distribution. |
package Log::Dispatch::ToTk; use strict; use vars qw($VERSION); use base qw(Log::Dispatch::Output); use fields qw/widget/ ; $VERSION = sprintf "%d.%03d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; sub new { my $proto = shift; my $class = ref $proto || $proto; my %params = @_; my $self = bless {} , $class; $self->{widget} = delete $params{-widget} || delete $params{widget} ; # remove leading '-' (Tk style) map { my $k = $_ ; s/^-//; $params{$_} = delete $params{$k} } grep /^-/,keys %params ; $self->_basic_init(%params); return $self ; } sub log { my $self = shift; my %params = @_; map {my $k = $_ ; s/^-//; $params{$_} = delete $params{$k}} grep /^-/,keys %params ; return unless $self->_should_log($params{level}); chomp $params{message}; my $nb = $self->_level_as_number($params{level}) ; $params{level} = $self->{level_names}[$nb] ; $self->{widget}->log(%params); } sub all_levels { my $self = shift; #print "From level $self->{min_level} to $self->{max_level}\n"; return @{$self->{level_names}}[$self->{min_level} .. $self->{max_level}] ; } __END__