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

(-)a/Koha/Logger.pm (-38 / +46 lines)
Lines 52-68 BEGIN { Link Here
52
52
53
sub get {
53
sub get {
54
    my ( $class, $params ) = @_;
54
    my ( $class, $params ) = @_;
55
    my $interface = $params? ($params->{interface} || C4::Context->interface):
55
    my $interface = $params ? ( $params->{interface} || C4::Context->interface ) : C4::Context->interface;
56
        C4::Context->interface;
56
    my $category = $params ? ( $params->{category} || caller ) : caller;
57
    my $category = $params? ($params->{category} || caller): caller;
57
    my $l4pcat = $interface . '.' . $category;
58
    my $l4pcat= $interface. '.'. $category;
59
58
60
    my $init= _init();
59
    my $init = _init();
61
    my $self = {};
60
    my $self = {};
62
    if( $init ) {
61
    if ($init) {
63
        $self->{logger} = Log::Log4perl->get_logger( $l4pcat );
62
        $self->{logger} = Log::Log4perl->get_logger($l4pcat);
64
        $self->{cat} = $l4pcat;
63
        $self->{cat}    = $l4pcat;
65
        $self->{logs} = $init if ref $init;
64
        $self->{logs}   = $init if ref $init;
66
    }
65
    }
67
    bless $self, $class;
66
    bless $self, $class;
68
    return $self;
67
    return $self;
Lines 80-97 sub get { Link Here
80
79
81
sub AUTOLOAD {
80
sub AUTOLOAD {
82
    my ( $self, $line ) = @_;
81
    my ( $self, $line ) = @_;
83
    my $method= $Koha::Logger::AUTOLOAD;
82
    my $method = $Koha::Logger::AUTOLOAD;
84
    $method =~ s/^Koha::Logger:://;
83
    $method =~ s/^Koha::Logger:://;
85
84
86
    if( !exists $self->{logger} ) {
85
    if ( !exists $self->{logger} ) {
86
87
        #do not use log4perl; no print to stderr
87
        #do not use log4perl; no print to stderr
88
    } elsif( !$self->_recheck_logfile ) {
88
    }
89
    elsif ( !$self->_recheck_logfile ) {
89
        print STDERR "Log file not writable for log4perl\n";
90
        print STDERR "Log file not writable for log4perl\n";
90
        print STDERR "$method: $line\n" if $line;
91
        print STDERR "$method: $line\n" if $line;
91
    } elsif( $self->{logger}->can($method) ) { #use log4perl
92
    }
92
        $self->{logger}->$method( $line );
93
    elsif ( $self->{logger}->can($method) ) {    #use log4perl
94
        $self->{logger}->$method($line);
93
        return 1;
95
        return 1;
94
    } else { # we should not really get here
96
    }
97
    else {                                       # we should not really get here
95
        print STDERR "ERROR: Unsupported method $method\n";
98
        print STDERR "ERROR: Unsupported method $method\n";
96
    }
99
    }
97
    return;
100
    return;
Lines 103-109 sub AUTOLOAD { Link Here
103
106
104
=cut
107
=cut
105
108
106
sub DESTROY {}
109
sub DESTROY { }
107
110
108
=head2 _init, _check_conf and _recheck_logfile
111
=head2 _init, _check_conf and _recheck_logfile
109
112
Lines 112-167 sub DESTROY {} Link Here
112
sub _init {
115
sub _init {
113
    my $rv;
116
    my $rv;
114
    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
117
    if ( exists $ENV{"LOG4PERL_CONF"} and $ENV{'LOG4PERL_CONF'} and -s $ENV{"LOG4PERL_CONF"} ) {
118
115
        # Check for web server level configuration first
119
        # Check for web server level configuration first
116
        # In this case we ASSUME that you correctly arranged logfile
120
        # In this case we ASSUME that you correctly arranged logfile
117
        # permissions. If not, log4perl will crash on you.
121
        # permissions. If not, log4perl will crash on you.
118
        # We will not parse apache files here.
122
        # We will not parse apache files here.
119
        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
123
        Log::Log4perl->init_once( $ENV{"LOG4PERL_CONF"} );
120
    } elsif ( C4::Context->config("log4perl_conf") ) {
124
    }
125
    elsif ( C4::Context->config("log4perl_conf") ) {
126
121
        # Now look in the koha conf file. We only check the permissions of
127
        # Now look in the koha conf file. We only check the permissions of
122
        # the default logfiles. For the rest, we again ASSUME that
128
        # the default logfiles. For the rest, we again ASSUME that
123
        # you arranged file permissions.
129
        # you arranged file permissions.
124
        my $conf= C4::Context->config("log4perl_conf");
130
        my $conf = C4::Context->config("log4perl_conf");
125
        if( $rv = _check_conf($conf) ) {
131
        if ( $rv = _check_conf($conf) ) {
126
            Log::Log4perl->init_once( $conf );
132
            Log::Log4perl->init_once($conf);
127
            return $rv;
133
            return $rv;
128
        } else {
134
        }
135
        else {
129
            return 0;
136
            return 0;
130
        }
137
        }
131
    } else {
132
       # This means that you do not use log4perl currently.
133
       # We will not be forcing it.
134
       return 0;
135
    }
138
    }
136
    return 1; # if we make it here, log4perl did not crash :)
139
    else {
140
        # This means that you do not use log4perl currently.
141
        # We will not be forcing it.
142
        return 0;
143
    }
144
    return 1;    # if we make it here, log4perl did not crash :)
137
}
145
}
138
146
139
sub _check_conf { # check logfiles in log4perl config (at initialization)
147
sub _check_conf {    # check logfiles in log4perl config (at initialization)
140
    my $file = shift;
148
    my $file = shift;
141
    return if !-r $file;
149
    return if !-r $file;
142
    open my $fh, '<', $file;
150
    open my $fh, '<', $file;
143
    my @lines = <$fh>;
151
    my @lines = <$fh>;
144
    close $fh;
152
    close $fh;
145
    my @logs;
153
    my @logs;
146
    foreach my $l ( @lines ) {
154
    foreach my $l (@lines) {
147
        if( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
155
        if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) {
148
        # we only check the two default logfiles, skipping additional ones
156
157
            # we only check the two default logfiles, skipping additional ones
149
            return if !-w $2;
158
            return if !-w $2;
150
            push @logs, $1.':'.$2;
159
            push @logs, $1 . ':' . $2;
151
        }
160
        }
152
    }
161
    }
153
    return if !@logs; # we should find one
162
    return if !@logs;    # we should find one
154
    return \@logs;
163
    return \@logs;
155
}
164
}
156
165
157
sub _recheck_logfile { # recheck saved logfile when logging message
166
sub _recheck_logfile {    # recheck saved logfile when logging message
158
    my $self = shift;
167
    my $self = shift;
159
168
160
    return 1 if !exists $self->{logs}; # remember? your own responsibility
169
    return 1 if !exists $self->{logs};    # remember? your own responsibility
161
    my $opac= $self->{cat}=~ /^OPAC/;
170
    my $opac = $self->{cat} =~ /^OPAC/;
162
    my $log;
171
    my $log;
163
    foreach( @{$self->{logs}} ) {
172
    foreach ( @{ $self->{logs} } ) {
164
        $log=$_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
173
        $log = $_ if $opac && /^OPAC:/ || !$opac && /^INTRANET:/;
165
        last if $log;
174
        last if $log;
166
    }
175
    }
167
    $log =~ s/^(OPAC|INTRANET)://;
176
    $log =~ s/^(OPAC|INTRANET)://;
168
- 

Return to bug 14167