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