libevent-rpc-perl 1.08-2 / usr / share / perl5 / Event / RPC / Logger.pm

#-----------------------------------------------------------------------
# Copyright (C) 2005-2015 by 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 utf8;

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__

=encoding utf8

=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.de>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2015 by Jörn Reder <joern AT zyn.de>.

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

=cut