The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id: Logger.pm,v 1.5 2006/04/23 08:37:41 joern Exp $

#-----------------------------------------------------------------------
# Copyright (C) 2002-2006 Jörn Reder <joern AT zyn.de>.
# All Rights Reserved. See file COPYRIGHT for details.
# 
# This module is part of Event::RPC, which is free software; you can
# redistribute it and/or modify it under the same terms as Perl itself.
#-----------------------------------------------------------------------

package Event::RPC::Logger;

use strict;
use FileHandle;

sub get_filename		{ shift->{filename}			}
sub get_filename_fh		{ shift->{filename_fh}			}

sub get_fh_lref			{ shift->{fh_lref}			}
sub get_min_level		{ shift->{min_level}			}

sub set_fh_lref			{ shift->{fh_lref}		= $_[1]	}
sub set_min_level		{ shift->{min_level}		= $_[1]	}


sub new {
	my $class = shift;
	my %par = @_;
	my  ($filename, $fh_lref, $min_level) =
	@par{'filename','fh_lref','min_level'};

	my $filename_fh;
	if ( $filename ) {
		$filename_fh = FileHandle->new;
		open ($filename_fh, ">>$filename")
			or die "can't write log $filename";
		$filename_fh->autoflush(1);
	}

	if ( $fh_lref ) {
		foreach my $fh ( @{$fh_lref} ) {
			my $old_fh = select $fh;
			$| = 1;
			select $old_fh;
		}
	} else {
		$fh_lref = [];
	}

	my $self = bless {
		filename	=> $filename,
		filename_fh	=> $filename_fh,
		fh_lref		=> $fh_lref,
		min_level	=> $min_level,
	}, $class;
	
	return $self;
}

sub DESTROY {
	my $self = shift;
	
	my $filename_fh = $self->get_filename_fh;
	close $filename_fh if $filename_fh;

	1;
}

sub log {
	my $self = shift;
	my ($level, $msg);
	if ( @_ == 2 ) {
		$level = $_[0];
		$msg   = $_[1];
	} else {
		$level = 1;
		$msg = $_[0];
	}

	return if $level > $self->get_min_level;
	
	$msg .= "\n" if $msg !~ /\n$/;

	my $str = localtime(time)." [$level] $msg";

	for my $fh ( @{$self->get_fh_lref} ) {
		print $fh $str if $fh;
	}

	my $fh = $self->get_filename_fh;
	print $fh $str if $fh;

	1;
}

sub add_fh {
	my $self = shift;
	my ($fh) = @_;

	push @{$self->get_fh_lref}, $fh;

	1;
}

sub remove_fh {
	my $self = shift;
	my ($fh) = @_;

	my $fh_lref = $self->get_fh_lref;

	my $i;
	for ( $i=0; $i<@{$fh_lref}; ++$i ) {
		last if $fh_lref->[$i] eq $fh;
	}

	return if $i == @{$fh_lref};
	splice @{$fh_lref}, $i, 1;
	
	1;
}

1;

__END__

=head1 NAME

Event::RPC::Logger - Logging facility for Event::RPC

=head1 SYNOPSIS

  use Event::RPC::Server;
  use Event::RPC::Logger;
  
  my $server = Event::RPC::Server->new (
      ...
      logger => Event::RPC::Logger->new(
          filename  => "/var/log/myserver.log",
	  fh_lref   => [ $fh, $sock ],
	  min_level => 2,
      ),
      ...
  );

  $server->start;

=head1 DESCRIPTION

This modules implements a simple logging facility for the
Event::RPC framework. Log messages may be written to a
specific file and/or a bunch of filehandles, which may be
sockets as well.

=head1 CONFIGURATION OPTIONS

This is a list of options you can pass to the new() constructor:

=over 4

=item B<filename>

All log messages are appended to this file.

=item B<fh_lref>

All log messages are printed into this list of filehandles.

=item B<min_level>

This is the minimum log level. Output of messages with a lower level
is suppressed. This option may be altered using set_min_level() even
in a running server.

=back

=head1 METHODS

=over 4

=item $logger->B<log> ( [$level, ] $msg )

The log() method does the actual logging. Called with one argument
the messages gets the default level of 1. With two argumens the first
is the level for the message.

=item $logger->B<add_fh> ( $fh )

This adds a filehandle to the internal list of filhandles all log
messages are written to.

=item $logger->B<remove_fh> ( $fh )

Removes a filehandle.

=back

=head1 AUTHORS

  Jörn Reder <joern at zyn dot de>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2002-2006 by Joern Reder, All Rights Reserved.

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut