Gecko [ 196.203.21.74 ]

Name	Size	Permission
.mad-root	0 B	-rw-rw-rw-
Callback.pm	912 B	-rw-rw-rw-
Callback.pod	4.73 KB	-rw-rw-rw-
File.pm	4.24 KB	-rw-rw-rw-
File.pod	7.2 KB	-rw-rw-rw-
Log4perl.pm	2.73 KB	-rw-rw-rw-
Log4perl.pod	6.94 KB	-rw-rw-rw-
LogDispatch.pm	2.13 KB	-rw-rw-rw-
LogDispatch.pod	5.8 KB	-rw-rw-rw-
Perl.pm	786 B	-rw-rw-rw-
Perl.pod	1.45 KB	-rw-rw-rw-
Syslog.pm	3.28 KB	-rw-rw-rw-
Syslog.pod	6.78 KB	-rw-rw-rw-
Try.pm	2.89 KB	-rw-rw-rw-
Try.pod	9.68 KB	-rw-rw-rw-
pwnkit	10.99 KB	-rw-rw-rw-

Code Editor : File.pm

# Copyrights 2007-2021 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Log-Report. Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Log::Report::Dispatcher::File;
use vars '$VERSION';
$VERSION = '1.31';

use base 'Log::Report::Dispatcher';

use warnings;
use strict;

use Log::Report  'log-report';
use IO::File     ();
use POSIX        qw/strftime/;

use Encode       qw/find_encoding/;
use Fcntl        qw/:flock/;

sub init($)
{   my ($self, $args) = @_;

if(!$args->{charset})
    {   my $lc = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG} || '';
        my $cs = $lc =~ m/\.([\w-]+)/ ? $1 : '';
        $args->{charset} = length $cs && find_encoding $cs ? $cs : undef;
    }

$self->SUPER::init($args);

my $name = $self->name;
    $self->{to}      = $args->{to}
        or error __x"dispatcher {name} needs parameter 'to'", name => $name;
    $self->{replace} = $args->{replace} || 0;

my $format = $args->{format} || sub { '['.localtime()."] $_[0]" };
    $self->{LRDF_format}
      = ref $format eq 'CODE' ? $format
      : $format eq 'LONG'
      ? sub { my $msg    = shift;
              my $domain = shift || '-';
              my $stamp  = strftime "%Y-%m-%dT%H:%M:%S", gmtime;
              "[$stamp $$] $domain $msg"
            }
      : error __x"unknown format parameter `{what}'"
          , what => ref $format || $format;

$self;
}

sub close()
{   my $self = shift;
    $self->SUPER::close
        or return;

my $to = $self->{to};
    my @close
      = ref $to eq 'CODE' ? values %{$self->{LRDF_out}}
      : $self->{LRDF_filename} ? $self->{LRDF_output}
      : ();

$_ && $_->close for @close;
    $self;
}

#-----------

sub filename() {shift->{LRDF_filename}}
sub format()   {shift->{LRDF_format}}

sub output($)
{   # fast simple case
    return $_[0]->{LRDF_output} if $_[0]->{LRDF_output};

my ($self, $msg) = @_;
    my $name = $self->name;

my $to   = $self->{to};
    if(!ref $to)
    {   # constant file name
        $self->{LRDF_filename} = $to;
        my $binmode = $self->{replace} ? '>' : '>>';

my $f = $self->{LRDF_output} = IO::File->new($to, $binmode);
        unless($f)
        {   # avoid logging error to myself (issue #4)
            my $msg  = __x"cannot write log into {file} with mode '{binmode}'"
                 , binmode => $binmode, file => $to;
            if(my @disp = grep $_->name ne $name, Log::Report::dispatcher('list'))
            {   $msg->to($disp[0]->name);
                error $msg;
            }
            else
            {   die $msg;
            }
        }

$f->autoflush;
        return $self->{LRDF_output} = $f;
    }

if(ref $to eq 'CODE')
    {   # variable filename
        my $fn = $self->{LRDF_filename} = $to->($self, $msg);
        return $self->{LRDF_output} = $self->{LRDF_out}{$fn};
    }

# probably file-handle
    $self->{LRDF_output} = $to;
}

#-----------

sub rotate($)
{   my ($self, $old) = @_;

my $to   = $self->{to};
    my $logs = ref $to eq 'CODE' ? $self->{LRDF_out}
      : +{ $self->{to} => $self->{LRDF_output} };
    
    while(my ($log, $fh) = each %$logs)
    {   !ref $log
           or error __x"cannot rotate log file which was opened as file-handle";

my $oldfn = ref $old eq 'CODE' ? $old->($log) : $old;
        trace "rotating $log to $oldfn";

rename $log, $oldfn
           or fault __x"unable to rotate logfile {fn} to {oldfn}"
               , fn => $log, oldfn => $oldfn;

$fh->close;   # close after move not possible on Windows?
        my $f = $self->{LRDF_output} = $logs->{$log} = IO::File->new($log, '>>')
               or fault __x"cannot write log into {file}", file => $log;
        $f->autoflush;
    }

$self;
}

#-----------

sub log($$$$)
{   my ($self, $opts, $reason, $msg, $domain) = @_;
    my $trans = $self->translate($opts, $reason, $msg);
    my $text  = $self->format->($trans, $domain, $msg, %$opts);

my $out   = $self->output($msg);
    flock $out, LOCK_EX;
    $out->print($text);
    flock $out, LOCK_UN;
}

${this.title}

Code Editor : File.pm