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