File Coverage

blib/lib/Paranoid/Log/Buffer.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	5	8	62.5
condition			n/a
subroutine	11	11	100.0
pod	5	5	100.0
total	62	65	95.3

# Paranoid::Log::Buffer -- Log buffer support for paranoid programs
#
# $Id: lib/Paranoid/Log/Buffer.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the Artistic License 2.0
#          ,
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2020, Arthur Corliss ([e-mail])
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::Log::Buffer;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION);
use Paranoid::Debug qw(:all);

($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );

use constant DEFAULT_BUFFSIZE => 20;

#####################################################################
#
# Module code follows
#
#####################################################################

{

    # Buffers
    my %buffers = ();

    sub addLogger {

        # Purpose:  Creates the named buffer
        # Returns:  Boolean
        # Usage:    $rv = addLogger(%rec);

        my %rec = @_;

        $buffers{ $rec{name} } = [];

        return 1;
    }

    sub delLogger {

        # Purpose:  Deletes the named buffer
        # Returns:  True (1)
        # Usage:    $rv = _delBuffer($name);

        my $name = shift;

        delete $buffers{$name} if exists $buffers{$name};

        return 1;
    }

    sub init {
        return 1;
    }

    sub logMsg {
        my %record = @_;
        my ( $rv, $size, $buffer );

        subPreamble( PDLEVEL1, '%' );

        if ( exists $buffers{ $record{name} } ) {
            $size =
                exists $record{options}{size}
                ? $record{options}{size}
                : DEFAULT_BUFFSIZE;
            $buffer = $buffers{ $record{name} };

            # Add the message
            push @$buffer, [ @record{qw(msgtime message)} ];

            # Trim if needed
            while ( scalar @$buffer > $size ) {
                shift @$buffer;
            }

            $rv = 1;
        }

        subPostamble( PDLEVEL1, '$', $rv );

        return $rv;
    }

    sub dumpBuffer {

        # Purpose:  Returns the contents of the named buffer
        # Returns:  Array
        # Usage:    @events = dump($name);

        my $name = shift;
        my @rv;

        @rv = @{ $buffers{$name} } if exists $buffers{$name};

        return @rv;
    }

}

1;

__END__