package NGCP::Log;

=encoding utf8

=head1 NAME

NGCP::Log - logging support for NGCP programs and daemons

=head1 DESCRIPTION

The NGCP::Log class can be used to log to various targets in a transparent
way.

=cut

use strict;
use warnings;

use Sys::Syslog qw(:standard :macros);

our $VERSION = '0.01';

use constant {
    OUTPUT_NONE     => 0x0000,
    OUTPUT_FILE     => 0x0001,
    OUTPUT_SYSLOG   => 0x0002,
    OUTPUT_CONSOLE  => 0x0004,
    OUTPUT_BOTH     => 0x0006, # OUPUT_SYSLOG | OUTPUT_CONSOLE
};

my %output_names = (
    none    => OUTPUT_NONE(),
    syslog  => OUTPUT_SYSLOG(),
    console => OUTPUT_CONSOLE(),
    both    => OUTPUT_BOTH(),
);

sub _get_default_output
{
    my $output = shift;

    if (defined $output) {
        $output = $output_names{$output} // OUTPUT_FILE;
    } else {
        $output = OUTPUT_CONSOLE;
    }

    return $output;
}

my %priority = (
    fatal => {
        level => LOG_CRIT,
        stream => 'warn',
    },
    error => {
        level => LOG_ERR,
        stream => 'warn',
    },
    warning => {
        level => LOG_WARNING,
        stream => 'warn',
    },
    notice => {
        level => LOG_NOTICE,
        stream => 'info',
    },
    info => {
        level => LOG_INFO,
        stream => 'info',
    },
    debug => {
        level => LOG_DEBUG,
        stream => 'warn',
        prefix => 'DEBUG',
    },
);

sub _get_default_prio
{
    my $prio = shift;

    if (defined $prio) {
        $prio = $priority{$prio}->{level} // $prio;
    } else {
        $prio = $priority{info}->{level};
    }

    return $prio;
}

sub _open_logfile
{
    my $logfile = shift;

    open my $fh, '>>', $logfile or croak("cannot open logfile $logfile");
    open STDOUT, '>&', $fh or croak("cannot redirect stdout to $logfile");
    open STDERR, '>&', $fh or croak("cannot redirect stderr to $logfile");
}

=head1 METHODS

=over 4

=item $log = NGCP::Log->new(%opts)

Create a new NGCP::Log object.
The following options can be set to control the logging behavior:

=over 4

=item progname => $name

The program name to use as prefix for log entries.
It defaults to the basename of the current program name being executed.

=item output => $name

Where to output the logs to.
It can be one of B<none> to perform no logging but it will still die on
fatal errors, B<syslog> to log into syslog, B<console> to log into stdout
and stderr, B<both> to log into both syslog and console, or it can be a
I<filename>.
The default is B<console>.

=item upto => $name

The priority to log up to (inclusive).
The supported priorities in increasing order of verbosity are B<fatal>,
B<error>, B<warning>, B<notice>, B<info> and B<debug>.
The default is B<info>.

=item facility => $name

The syslog facility to use, as documented in L<Sys::Syslog>.
The default is B<user>.

=item use_timestamps => $bool

Whether to print the console messages with a timestamp.
The default is B<0>.

=item use_stdout => $bool

Whether to print to stdout for notice and info and methods when logging to
the console, or to use stderr.
The default is B<1> to emit those messages to stdout.

=item hook_handlers => $bool

Whether to hook the warning and fatal methods into the __WARN__ and __DIE__
handlers.
The default is B<0>.

=back

=cut

sub new
{
    my ($this, %opts) = @_;
    my $class = ref($this) || $this;
    my $self = {
        progname => $opts{progname} // $0 =~ m{(?:.*/)?([^/]*)},
        use_timestamps => $opts{use_timestamps} // 0,
        use_stdout => $opts{use_stdout} // 1,
        output => _get_default_output($opts{output}),
        upto => _get_default_prio($opts{upto}),
        facility => $opts{facility} // LOG_USER,
        hook_handlers => $opts{hook_handlers} // 0,
    };
    bless $self, $class;

    $self->{stream}{info} = $self->{use_stdout} ? \*STDOUT : \*STDERR;
    $self->{stream}{warn} = \*STDERR;

    if ($self->{output} == OUTPUT_FILE) {
        $self->{logfile} = $opts{output};
        _open_logfile($self->{logfile});
        $self->{output} = OUTPUT_CONSOLE;
    }
    if ($self->{output} & OUTPUT_SYSLOG) {
        openlog($self->{progname}, 'pid,ndelay', $self->{facility});
        setlogmask(LOG_UPTO($self->{upto}));
    }
    if ($self->{hook_handlers}) {
        ## no critic (Variables::RequireLocalizedPunctuationVars)
        $SIG{__WARN__} = sub { $self->warning(@_) };
        $SIG{__DIE__} = sub { $self->fatal(@_) };
    }

    return $self;
}

sub DESTROY
{
    my $self = shift;

    if ($self->{output} & OUTPUT_SYSLOG) {
        closelog();
    }
    if (defined $self->{logfile}) {
        close $self->{logfile};
    }
}

=item $log->reload()

Triggers a reload of log files, if necessary.
Commonly used to hook from a SIGHUP signal handler.

=cut

sub reload
{
    my $self = shift;

    if ($self->{output} == OUTPUT_FILE) {
        _open_logfile($self->{logfile});
    }
}

sub _format
{
    my ($self, $msg) = @_;

    chomp $msg;
    if ($self->{use_timestamps}) {
        return sprintf "$self->{progname}: %s: %s\n", POSIX::strftime('%F %T', localtime), $msg;
    } else {
        return sprintf "$self->{progname}: %s\n", $msg;
    }
}

sub _emit
{
    my ($self, $prioname, $msg) = @_;

    my $prio = $priority{$prioname};
    my $prefix = $prio->{prefix} // $prioname;

    if ($self->{output} & OUTPUT_SYSLOG) {
        syslog($prio->{level}, "$prefix: $msg");
    }
    if ($self->{output} & OUTPUT_CONSOLE && $self->{upto} >= $prio->{level}) {
        my $stream = $self->{stream}{$prio->{stream}};
        print { $stream } ($self->_format("$prefix: $msg"));
    }

    if ($prio->{level} <= LOG_CRIT) {
        die "$prefix: $msg";
    }
}

=item $log->sysfatal($msg)

Emit a fatal error from a system call by including errno, and terminate the
program.

=cut

sub sysfatal
{
    my ($self, $msg) = @_;

    $self->_emit('fatal', "$msg: $!");
}

=item $log->fatal($msg)

Emit a fatal error and terminate the program.

=cut

sub fatal
{
    my ($self, $msg) = @_;

    $self->_emit('fatal', $msg);
}

=item $log->error($msg)

Emit an error.

=cut

sub error
{
    my ($self, $msg) = @_;

    $self->_emit('error', $msg);
}

=item $log->warning($msg)

Emit a warning.

=cut

sub warning
{
    my ($self, $msg) = @_;

    $self->_emit('warning', $msg);
}

=item $log->notice($msg)

Emit a notice.
When printing to the console it defaults to use stdout, but can be configured
to print to stderr instead, see the B<use_stdout> in the constructor.

=cut

sub notice
{
    my ($self, $msg) = @_;

    $self->_emit('notice', $msg);
}

=item $log->info($msg)

Emit an information message.
When printing to the console it defaults to use stdout, but can be configured
to print to stderr instead, see the B<use_stdout> in the constructor.

=cut

sub info
{
    my ($self, $msg) = @_;

    $self->_emit('info', $msg);
}

=item $log->debug($msg)

Emit a debug message.
By default no debugging messages will be logged, see the B<upto> option in
the constructor.

=cut

sub debug
{
    my ($self, $msg) = @_;

    $self->_emit('debug', $msg);
}

=back

=head1 BUGS AND LIMITATIONS

Please report problems you notice to the Sipwise
Development Team <support@sipwise.com>.

=head1 AUTHOR

Guillem Jover <gjover@sipwise.com>

=head1 LICENSE

Copyright (C) 2021 Sipwise GmbH, Austria

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut

1;
