Puppet::Log - Log facility with an optional Tk display

 use Puppet::Log ;

 my $log = new Puppet::Log('title' =>'log test') ;
 $log -> log("Some text") ;

 # $wmgr can be a toplevel Tk main window or a Tk::Multi::Manager
 $log ->display($wmgr, 1) ; 

############################################################
#
# $Header: /home/domi/perlDev/old/Puppet_Log/RCS/Log.pm,v 1.12 2006/02/23 08:25:56 domi Exp $
#
# $Source: /home/domi/perlDev/old/Puppet_Log/RCS/Log.pm,v $
# $Revision: 1.12 $
# $Locker:  $
# 
############################################################

# Copyright (c) 1998,1999,2006 Dominique Dumont. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Puppet::Log ;
use Puppet::LogBody ;

use Carp ;

use strict ;
use vars qw(@ISA $VERSION) ;

@ISA=qw/Puppet::LogBody/ ;

$VERSION = sprintf "%d.%03d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;

# see loadspecs for other names

sub new 
  {
    my $type = shift ;

    my $title ;
    if (scalar @_ % 2)
      {
        carp "Unnamed 'title' parameter is deprecated with Puppet::Log\n";
        $title = shift ;
      }

    my %args = @_ ;
    $title = delete $args{title} unless defined $title;

    if (defined $args{whenNoDisplay})
      {
        carp "whenNoDisplay parameter is deprecated with Puppet::Log->new\n";
        $args{how}=delete $args{whenNoDisplay};
      }


    my $help = delete $args{'help'} || '';
    # parameter 'title' is a short name for the Tk window
    # parameter 'name' is a long name for the casual print

    my $self = new Puppet::LogBody(%args);
    $self->{help} = $help ;
    $self->{title} = $title ;

    bless $self,$type;
  }

sub log
  {
    my $self = shift ;
    my $text = shift ;
    my %args = @_;

    if (defined $args{whenNoDisplay})
      {
        carp "whenNoDisplay parameter is deprecated with Puppet::Log->log\n";
        $args{how}=delete $args{whenNoDisplay};
      }

    $text = $self->SUPER::log($text,%args);

    if (defined $self->{'textObj'})
      {
        $self->{'textObj'}->insertText($text) ;
      }
  }

sub clear
  {
    my $self = shift ;
    $self->SUPER::clear();
    if (defined $self->{'textObj'}) {$self->{'textObj'}->clear ;}
  }

sub display
  {
    my $self =shift ;
    # ref is either a toplevel or a multi manager, optionnal if display was
    # already called once.
    my $ref = shift ; 
    my $hidden = shift || 0 ; #optionnal

    # load only when display is called
    require Tk::Multi::Manager ;
    require Tk::Multi::Text ;
    require Tk::Multi::Toplevel ;

    # don't create 2 displays
    if (defined $self->{textObj})
      {
        my $mytop = $self->{textObj}->toplevel ;
        $mytop->deiconify() if ($mytop->state() eq 'iconic');
        $mytop->raise();
        return $self->{manager};
      }

    croak( "No ref (should be either a Toplevel or a MultiManager) ",
    "given for Puppet::Log\n" )
      unless defined $ref ;

    if (ref($ref) eq 'Tk::Toplevel' or ref($ref) eq 'MainWindow')
      {
        $self->{manager} = $ref -> MultiTop 
          (
           'title' => 'log '.$self->{title}, 
          ) ;
        $self->{manager}->OnDestroy(sub{$ref->destroy;});
      }
    elsif (ref($ref) eq 'Tk::Multi::Manager' 
           or ref($ref) eq 'Tk::Multi::Toplevel')
      {
        $self->{manager} = $ref ;
      }
    else
      {
        croak("Unexpected tk object ( ",ref($ref)," ) given to Puppet::Log\n");
      }

    $self->{'textObj'} = $self->{manager} -> newSlave
      (
       'type' => 'MultiText',
       'title' => $self->{title},
       'hidden' => $hidden ,
       'help' => $self->{help}
      ) ;

    $self->{textObj} -> OnDestroy(sub{$self->close;}) ;

    map ($self->{'textObj'} -> insertText($_),$self->getAll()) ;

    return $self->{manager} ;
  }

sub show
  {
    my $self = shift ;

    if (defined $self->{manager})
      {
        $self->{'manager'}->show($self->{title});      
      }
  }

sub close
  {
    my $self = shift ;

    delete $self->{textObj} ; # delete the reference in the hash
    delete $self->{manager} ;
  }



1;

__END__