File Coverage

blib/lib/Paranoid/Log/File.pm

Criterion	Covered	Total	%
statement	67	68	98.5
branch	12	18	66.6
condition	3	6	50.0
subroutine	15	15	100.0
pod	4	4	100.0
total	101	111	90.9

# Paranoid::Log::File -- File Log support for paranoid programs
#
# $Id: lib/Paranoid/Log/File.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::File;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION);
use Paranoid::Debug qw(:all);
use Paranoid::Filesystem;
use Paranoid::Input;
use Paranoid::IO;
use Fcntl qw(:DEFAULT :flock :mode :seek);

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

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

{

    my $hostname;
    my $pname;

    sub _getHostname {

        # Purpose:  Returns the hostname, defaulting to localhost if
        #           /bin/hostname is unusable
        # Returns:  Hostname
        # Usage:    $hostname = _getHostname();

        my $fd;

        # Return cached result
        return $hostname if defined $hostname;

        # Get the current hostname
        if ( -x '/bin/hostname' ) {
            if ( open $fd, '-|', '/bin/hostname' ) {
                chomp( $hostname = <$fd> );
                close $fd;
            }
        }

        # Do a little sanitizing...
        if ( defined $hostname and length $hostname ) {
            $hostname =~ s/\..*$//so;
        } else {
            $hostname = 'localhost';
        }

        return $hostname;
    }

    sub _timestamp {

        # Purpose:  Returns a syslog-stype timestamp string for the current or
        #           passed time
        # Returns:  String
        # Usage:    $timestamp = ptimestamp();
        # Usage:    $timestamp = ptimestamp($epoch);

        my $utime  = shift;
        my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
        my @ctime;

        @ctime = defined $utime ? ( localtime $utime ) : (localtime);

        return sprintf
            '%s %2d %02d:%02d:%02d',
            $months[ $ctime[4] ],
            @ctime[ 3, 2, 1, 0 ];
    }

    sub init {
        _getHostname();
        ($pname) = ( $0 =~ m#^(?:.+/)?([^/]+)$#s );
        return 1;
    }

    sub addLogger {

        # Purpose:  Opens a handle the requested file
        # Returns:  Boolean
        # Usage:    $rv = addLogger(%record);

        my %record = @_;
        my ( $mode, $perm, $rv );

        subPreamble( PDLEVEL1, '%', %record );

        # Get mode and permissions
        $mode =
            exists $record{options}{mode}
            ? $record{options}{mode}
            : O_CREAT | O_APPEND | O_WRONLY;
        $perm = $record{options}{perm} if exists $record{options}{perm};
        pdebug( 'perm: %s mode: %s', PDLEVEL1, $perm, $mode );
        if ( defined $record{options}{file}
            and length $record{options}{file} ) {
            $rv = defined popen( $record{options}{file}, $mode, $perm );
        } else {
            Paranoid::ERROR =
                pdebug( 'invalid file name specified in options: %s',
                PDLEVEL1, $record{options}{file} );
        }

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

        return $rv;
    }

    sub delLogger {

        # Purpose:  Closes the requested file
        # Returns:  Return value of close
        # Usage:    $rv = delLogger(%record);

        my %record = @_;

        return pclose( $record{options}{file} );
    }

    sub logMsg {

        # Purpose:  Logs the passed message to the named file
        # Returns:  Return value of print()
        # Usage:    $rv = logMsg(%record);

        my %record = @_;
        my ( $message, $rv );

        subPreamble( PDLEVEL1, '%', %record );

        # Get the message and make sure it's terminated by a single newline
        $message = $record{message};
        $message =~ s/\n*$/\n/so;

        if ( $record{options}{syslog} ) {
            $message =~ s/\n//so;
            $message = sprintf "%s %s %s[%d]: %s\n",
                _timestamp( $record{msgtime} ), $hostname, $pname, $$,
                substr $message, 0, 2048;
        }

        $rv = pappend( $record{options}{file}, $message );

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

        return $rv;
    }
}

1;

__END__