1##################################################
2package Log::Log4perl::Appender::File;
3##################################################
4
5our @ISA = qw(Log::Log4perl::Appender);
6
7use warnings;
8use strict;
9use Log::Log4perl::Config::Watch;
10use Fcntl;
11use constant _INTERNAL_DEBUG => 0;
12
13##################################################
14sub new {
15##################################################
16    my($class, @options) = @_;
17
18    my $self = {
19        name      => "unknown name",
20        umask     => undef,
21        owner     => undef,
22        group     => undef,
23        autoflush => 1,
24        syswrite  => 0,
25        mode      => "append",
26        binmode   => undef,
27        utf8      => undef,
28        recreate  => 0,
29        recreate_check_interval => 30,
30        recreate_check_signal   => undef,
31        recreate_pid_write      => undef,
32        create_at_logtime       => 0,
33        @options,
34    };
35
36    if($self->{create_at_logtime}) {
37        $self->{recreate}  = 1;
38    }
39
40    if(defined $self->{umask} and $self->{umask} =~ /^0/) {
41            # umask value is a string, meant to be an oct value
42        $self->{umask} = oct($self->{umask});
43    }
44
45    die "Mandatory parameter 'filename' missing" unless
46        exists $self->{filename};
47
48    bless $self, $class;
49
50    if($self->{recreate_pid_write}) {
51        print "Creating pid file",
52              " $self->{recreate_pid_write}\n" if _INTERNAL_DEBUG;
53        open FILE, ">$self->{recreate_pid_write}" or
54            die "Cannot open $self->{recreate_pid_write}";
55        print FILE "$$\n";
56        close FILE;
57    }
58
59        # This will die() if it fails
60    $self->file_open() unless $self->{create_at_logtime};
61
62    return $self;
63}
64
65##################################################
66sub filename {
67##################################################
68    my($self) = @_;
69
70    return $self->{filename};
71}
72
73##################################################
74sub file_open {
75##################################################
76    my($self) = @_;
77
78    my $arrows  = ">";
79    my $sysmode = (O_CREAT|O_WRONLY);
80
81    my $old_umask = umask();
82
83    if($self->{mode} eq "append") {
84        $arrows   = ">>";
85        $sysmode |= O_APPEND;
86    } elsif ($self->{mode} eq "pipe") {
87        $arrows = "|";
88    } else {
89        $sysmode |= O_TRUNC;
90    }
91
92    my $fh = do { local *FH; *FH; };
93
94    umask($self->{umask}) if defined $self->{umask};
95
96    my $didnt_exist = ! -f $self->{filename};
97
98    if($self->{syswrite}) {
99        sysopen $fh, "$self->{filename}", $sysmode or
100            die "Can't sysopen $self->{filename} ($!)";
101    } else {
102        open $fh, "$arrows$self->{filename}" or
103            die "Can't open $self->{filename} ($!)";
104    }
105
106    if($didnt_exist and
107         ( defined $self->{owner} or defined $self->{group} )
108      ) {
109
110        eval { $self->perms_fix() };
111
112        if($@) {
113              # Cleanup and re-throw
114            unlink $self->{filename};
115            die $@;
116        }
117    }
118
119    if($self->{recreate}) {
120        $self->{watcher} = Log::Log4perl::Config::Watch->new(
121            file           => $self->{filename},
122            ($self->{recreate_check_interval} ?
123              (check_interval => $self->{recreate_check_interval}) : ()),
124            ($self->{recreate_check_signal} ?
125              (signal => $self->{recreate_check_signal}) : ()),
126        );
127    }
128
129    umask($old_umask) if defined $self->{umask};
130
131    $self->{fh} = $fh;
132
133    if ($self->{autoflush} and ! $self->{syswrite}) {
134        my $oldfh = select $self->{fh};
135        $| = 1;
136        select $oldfh;
137    }
138
139    if (defined $self->{binmode}) {
140        binmode $self->{fh}, $self->{binmode};
141    }
142
143    if (defined $self->{utf8}) {
144        binmode $self->{fh}, ":utf8";
145    }
146}
147
148##################################################
149sub file_close {
150##################################################
151    my($self) = @_;
152
153    undef $self->{fh};
154}
155
156##################################################
157sub perms_fix {
158##################################################
159    my($self) = @_;
160
161    my ($uid_org, $gid_org) = (stat $self->{filename})[4,5];
162
163    my ($uid, $gid) = ($uid_org, $gid_org);
164
165    if(!defined $uid) {
166        die "stat of $self->{filename} failed ($!)";
167    }
168
169    my $needs_fixing = 0;
170
171    if(defined $self->{owner}) {
172        $uid = $self->{owner};
173        if($self->{owner} !~ /^\d+$/) {
174            $uid = (getpwnam($self->{owner}))[2];
175            die "Unknown user: $self->{owner}" unless defined $uid;
176        }
177    }
178
179    if(defined $self->{group}) {
180        $gid = $self->{group};
181        if($self->{group} !~ /^\d+$/) {
182            $gid = getgrnam($self->{group});
183
184            die "Unknown group: $self->{group}" unless defined $gid;
185        }
186    }
187    if($uid != $uid_org or $gid != $gid_org) {
188        chown($uid, $gid, $self->{filename}) or
189            die "chown('$uid', '$gid') on '$self->{filename}' failed: $!";
190    }
191}
192
193##################################################
194sub file_switch {
195##################################################
196    my($self, $new_filename) = @_;
197
198    print "Switching file from $self->{filename} to $new_filename\n" if
199        _INTERNAL_DEBUG;
200
201    $self->file_close();
202    $self->{filename} = $new_filename;
203    $self->file_open();
204}
205
206##################################################
207sub log {
208##################################################
209    my($self, %params) = @_;
210
211    if($self->{recreate}) {
212        if($self->{recreate_check_signal}) {
213            if($self->{watcher}->{signal_caught}) {
214                $self->{watcher}->{signal_caught} = 0;
215                $self->file_switch($self->{filename});
216            }
217        } else {
218            if(!$self->{watcher} or
219                $self->{watcher}->file_has_moved()) {
220                $self->file_switch($self->{filename});
221            }
222        }
223    }
224
225    my $fh = $self->{fh};
226
227    if($self->{syswrite}) {
228        syswrite $fh, $params{message} or
229            die "Cannot syswrite to '$self->{filename}': $!";
230    } else {
231        print $fh $params{message} or
232            die "Cannot write to '$self->{filename}': $!";
233    }
234}
235
236##################################################
237sub DESTROY {
238##################################################
239    my($self) = @_;
240
241    if ($self->{fh}) {
242        my $fh = $self->{fh};
243        close $fh;
244    }
245}
246
2471;
248
249__END__
250
251=head1 NAME
252
253Log::Log4perl::Appender::File - Log to file
254
255=head1 SYNOPSIS
256
257    use Log::Log4perl::Appender::File;
258
259    my $app = Log::Log4perl::Appender::File->new(
260      filename  => 'file.log',
261      mode      => 'append',
262      autoflush => 1,
263      umask     => 0222,
264    );
265
266    $file->log(message => "Log me\n");
267
268=head1 DESCRIPTION
269
270This is a simple appender for writing to a file.
271
272The C<log()> method takes a single scalar. If a newline character
273should terminate the message, it has to be added explicitely.
274
275Upon destruction of the object, the filehandle to access the
276file is flushed and closed.
277
278If you want to switch over to a different logfile, use the
279C<file_switch($newfile)> method which will first close the old
280file handle and then open a one to the new file specified.
281
282=head2 OPTIONS
283
284=over 4
285
286=item filename
287
288Name of the log file.
289
290=item mode
291
292Messages will be append to the file if C<$mode> is set to the
293string C<"append">. Will clobber the file
294if set to C<"clobber">. If it is C<"pipe">, the file will be understood
295as executable to pipe output to. Default mode is C<"append">.
296
297=item autoflush
298
299C<autoflush>, if set to a true value, triggers flushing the data
300out to the file on every call to C<log()>. C<autoflush> is on by default.
301
302=item syswrite
303
304C<syswrite>, if set to a true value, makes sure that the appender uses
305syswrite() instead of print() to log the message. C<syswrite()> usually
306maps to the operating system's C<write()> function and makes sure that
307no other process writes to the same log file while C<write()> is busy.
308Might safe you from having to use other syncronisation measures like
309semaphores (see: Synchronized appender).
310
311=item umask
312
313Specifies the C<umask> to use when creating the file, determining
314the file's permission settings.
315If set to C<0222> (default), new
316files will be created with C<rw-r--r--> permissions.
317If set to C<0000>, new files will be created with C<rw-rw-rw-> permissions.
318
319=item owner
320
321If set, specifies that the owner of the newly created log file should
322be different from the effective user id of the running process.
323Only makes sense if the process is running as root.
324Both numerical user ids and user names are acceptable.
325
326=item group
327
328If set, specifies that the group of the newly created log file should
329be different from the effective group id of the running process.
330Only makes sense if the process is running as root.
331Both numerical group ids and group names are acceptable.
332
333=item utf8
334
335If you're printing out Unicode strings, the output filehandle needs
336to be set into C<:utf8> mode:
337
338    my $app = Log::Log4perl::Appender::File->new(
339      filename  => 'file.log',
340      mode      => 'append',
341      utf8      => 1,
342    );
343
344=item binmode
345
346To manipulate the output filehandle via C<binmode()>, use the
347binmode parameter:
348
349    my $app = Log::Log4perl::Appender::File->new(
350      filename  => 'file.log',
351      mode      => 'append',
352      binmode   => ":utf8",
353    );
354
355A setting of ":utf8" for C<binmode> is equivalent to specifying
356the C<utf8> option (see above).
357
358=item recreate
359
360Normally, if a file appender logs to a file and the file gets moved to
361a different location (e.g. via C<mv>), the appender's open file handle
362will automatically follow the file to the new location.
363
364This may be undesirable. When using an external logfile rotator,
365for example, the appender should create a new file under the old name
366and start logging into it. If the C<recreate> option is set to a true value,
367C<Log::Log4perl::Appender::File> will do exactly that. It defaults to
368false. Check the C<recreate_check_interval> option for performance
369optimizations with this feature.
370
371=item recreate_check_interval
372
373In C<recreate> mode, the appender has to continuously check if the
374file it is logging to is still in the same location. This check is
375fairly expensive, since it has to call C<stat> on the file name and
376figure out if its inode has changed. Doing this with every call
377to C<log> can be prohibitively expensive. Setting it to a positive
378integer value N will only check the file every N seconds. It defaults to 30.
379
380This obviously means that the appender will continue writing to
381a moved file until the next check occurs, in the worst case
382this will happen C<recreate_check_interval> seconds after the file
383has been moved or deleted. If this is undesirable,
384setting C<recreate_check_interval> to 0 will have the appender
385appender check the file with I<every> call to C<log()>.
386
387=item recreate_check_signal
388
389In C<recreate> mode, if this option is set to a signal name
390(e.g. "USR1"), the appender will recreate a missing logfile
391when it receives the signal. It uses less resources than constant
392polling. The usual limitation with perl's signal handling apply.
393Check the FAQ for using this option with the log rotating
394utility C<newsyslog>.
395
396=item recreate_pid_write
397
398The popular log rotating utility C<newsyslog> expects a pid file
399in order to send the application a signal when its logs have
400been rotated. This option expects a path to a file where the pid
401of the currently running application gets written to.
402Check the FAQ for using this option with the log rotating
403utility C<newsyslog>.
404
405=item create_at_logtime
406
407The file appender typically creates its logfile in its constructor, i.e.
408at Log4perl C<init()> time. This is desirable for most use cases, because
409it makes sure that file permission problems get detected right away, and
410not after days/weeks/months of operation when the appender suddenly needs
411to log something and fails because of a problem that was obvious at
412startup.
413
414However, there are rare use cases where the file shouldn't be created
415at Log4perl C<init()> time, e.g. if the appender can't be used by the current
416user although it is defined in the configuration file. If you set
417C<create_at_logtime> to a true value, the file appender will try to create
418the file at log time. Note that this setting lets permission problems
419sit undetected until log time, which might be undesirable.
420
421=back
422
423Design and implementation of this module has been greatly inspired by
424Dave Rolsky's C<Log::Dispatch> appender framework.
425
426=head1 AUTHOR
427
428Mike Schilli <log4perl@perlmeister.com>, 2003, 2005
429
430=cut
431