View | Details | Raw Unified | Return to bug 14167
Collapse All | Expand All

(-)a/Koha/Logger.pm (-34 / +118 lines)
Lines 39-92 use C4::Context; Link Here
39
39
40
BEGIN {
40
BEGIN {
41
    Log::Log4perl->wrapper_register(__PACKAGE__);
41
    Log::Log4perl->wrapper_register(__PACKAGE__);
42
43
    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
44
        # Check for web server level configuration first
45
        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
46
    }
47
    elsif ( C4::Context->config("log4perl_conf") ) {
48
        # If no web server level config exists, look in the koha conf file for one
49
        Log::Log4perl->init_once( C4::Context->config("log4perl_conf") );
50
    } else {
51
        my $logdir = C4::Context->config("logdir");
52
        my $conf = qq(
53
            log4perl.logger.intranet = WARN, INTRANET
54
            log4perl.appender.INTRANET=Log::Log4perl::Appender::File
55
            log4perl.appender.INTRANET.filename=$logdir/intranet-error.log
56
            log4perl.appender.INTRANET.mode=append
57
            log4perl.appender.INTRANET.layout=PatternLayout
58
            log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n
59
60
            log4perl.logger.opac = WARN, OPAC
61
            log4perl.appender.OPAC=Log::Log4perl::Appender::File
62
            log4perl.appender.OPAC.filename=$logdir/opac-error.log
63
            log4perl.appender.OPAC.mode=append
64
            log4perl.appender.OPAC.layout=PatternLayout
65
            log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
66
        );
67
        Log::Log4perl->init_once(\$conf);
68
    }
69
}
42
}
70
43
71
=head2 get
44
=head2 get
72
45
73
    Returns a log4perl object.
46
    Returns a logger object (based on log4perl).
74
    Category and interface parameter are optional.
47
    Category and interface hash parameter are optional.
75
    Normally, the category should follow the current package and the interface
48
    Normally, the category should follow the current package and the interface
76
    should be set correctly via C4::Context.
49
    should be set correctly via C4::Context.
77
50
78
=cut
51
=cut
79
52
80
sub get {
53
sub get {
81
    my ( $class, $category, $interface ) = @_;
54
    my ( $class, $params ) = @_;
82
    $interface ||= C4::Context->interface();
55
    my $interface = $params? ($params->{interface} || C4::Context->interface):
83
    $category = caller if !$category;
56
        C4::Context->interface;
84
    return Log::Log4perl->get_logger( $interface. '.'. $category );
57
    my $category = $params? ($params->{category} || caller): caller;
58
    my $l4pcat= $interface. '.'. $category;
59
60
    my $init= _init();
61
    my $self = {};
62
    if( $init ) {
63
        $self->{logger} = Log::Log4perl->get_logger( $l4pcat );
64
        $self->{cat} = $l4pcat;
65
        $self->{logs} = $init if ref $init;
66
    }
67
    bless $self, $class;
68
    return $self;
69
}
70
71
=head1 INTERNALS
72
73
=head2 AUTOLOAD
74
75
    In order to prevent a crash when log4perl cannot write to Koha logfile,
76
    we check first before calling log4perl.
77
    If log4perl would add such a check, this would no longer be needed.
78
79
=cut
80
81
sub AUTOLOAD {
82
    my ( $self, $line ) = @_;
83
    my $method= $Koha::Logger::AUTOLOAD;
84
    $method =~ s/^Koha::Logger:://;
85
86
    if( !exists $self->{logger} ) {
87
        #do not use log4perl; no print to stderr
88
    } elsif( !$self->_recheck_logfile ) {
89
        print STDERR "Log file not writable for log4perl\n";
90
        print STDERR "$method: $line\n" if $line;
91
    } elsif( $self->{logger}->can($method) ) { #use log4perl
92
        $self->{logger}->$method( $line );
93
        return 1;
94
    } else { # we should not really get here
95
        print STDERR "ERROR: Unsupported method $method\n";
96
    }
97
    return;
98
}
99
100
=head2 DESTROY
101
102
    Dummy destroy to prevent call to AUTOLOAD
103
104
=cut
105
106
sub DESTROY {}
107
108
=head2 _init, _check_conf and _recheck_logfile
109
110
=cut
111
112
sub _init {
113
    my $rv;
114
    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
115
        # Check for web server level configuration first
116
        # In this case we ASSUME that you correctly arranged logfile
117
        # permissions. If not, log4perl will crash on you.
118
        # We will not parse apache files here.
119
        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
120
    } elsif ( C4::Context->config("log4perl_conf") ) {
121
        # Now look in the koha conf file. We only check the permissions of
122
        # the default logfiles. For the rest, we again ASSUME that
123
        # you arranged file permissions.
124
        my $conf= C4::Context->config("log4perl_conf");
125
        if( $rv = _check_conf($conf) ) {
126
            Log::Log4perl->init_once( $conf );
127
            return $rv;
128
        } else {
129
            return 0;
130
        }
131
    } else {
132
       # This means that you do not use log4perl currently.
133
       # We will not be forcing it.
134
       return 0;
135
    }
136
    return 1; # if we make it here, log4perl did not crash :)
137
}
138
139
sub _check_conf { # check logfiles in log4perl config (at initialization)
140
    my $file = shift;
141
    return if !-r $file;
142
    open my $fh, '<', $file;
143
    my @lines = <$fh>;
144
    close $fh;
145
    my @logs;
146
    foreach my $l ( @lines ) {
147
        if( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
148
        # we only check the two default logfiles, skipping additional ones
149
            return if !-w $2;
150
            push @logs, $1.':'.$2;
151
        }
152
    }
153
    return if !@logs; # we should find one
154
    return \@logs;
155
}
156
157
sub _recheck_logfile { # recheck saved logfile when logging message
158
    my $self = shift;
159
160
    return 1 if !exists $self->{logs}; # remember? your own responsibility
161
    my $opac= $self->{cat}=~ /^OPAC/;
162
    my $log;
163
    foreach( @{$self->{logs}} ) {
164
        $log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
165
        last if $log;
166
    }
167
    $log =~ s/^(OPAC|INTRANET)://;
168
    return -w $log;
85
}
169
}
86
170
87
=head1 AUTHOR
171
=head1 AUTHOR
88
172
89
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
173
Kyle M Hall, E<lt>kyle@bywatersolutions.comE<gt>
174
Marcel de Rooy, Rijksmuseum
90
175
91
=cut
176
=cut
92
177
93
- 

Return to bug 14167