1package Log::Dispatch::File; 2{ 3 $Log::Dispatch::File::VERSION = '2.34'; 4} 5 6use strict; 7use warnings; 8 9use Log::Dispatch::Output; 10 11use base qw( Log::Dispatch::Output ); 12 13use Params::Validate qw(validate SCALAR BOOLEAN); 14Params::Validate::validation_options( allow_extra => 1 ); 15 16use Scalar::Util qw( openhandle ); 17 18# Prevents death later on if IO::File can't export this constant. 19*O_APPEND = \&APPEND unless defined &O_APPEND; 20 21sub APPEND { 0 } 22 23sub new { 24 my $proto = shift; 25 my $class = ref $proto || $proto; 26 27 my %p = @_; 28 29 my $self = bless {}, $class; 30 31 $self->_basic_init(%p); 32 $self->_make_handle(%p); 33 34 return $self; 35} 36 37sub _make_handle { 38 my $self = shift; 39 40 my %p = validate( 41 @_, 42 { 43 filename => { type => SCALAR }, 44 mode => { 45 type => SCALAR, 46 default => '>' 47 }, 48 binmode => { 49 type => SCALAR, 50 default => undef 51 }, 52 autoflush => { 53 type => BOOLEAN, 54 default => 1 55 }, 56 close_after_write => { 57 type => BOOLEAN, 58 default => 0 59 }, 60 permissions => { 61 type => SCALAR, 62 optional => 1 63 }, 64 } 65 ); 66 67 $self->{filename} = $p{filename}; 68 $self->{close} = $p{close_after_write}; 69 $self->{permissions} = $p{permissions}; 70 $self->{binmode} = $p{binmode}; 71 $self->{syswrite} = $p{syswrite}; 72 73 if ( $self->{close} ) { 74 $self->{mode} = '>>'; 75 } 76 elsif ( 77 exists $p{mode} 78 && defined $p{mode} 79 && ( 80 $p{mode} =~ /^(?:>>|append)$/ 81 || ( $p{mode} =~ /^\d+$/ 82 && $p{mode} == O_APPEND() ) 83 ) 84 ) { 85 $self->{mode} = '>>'; 86 } 87 else { 88 $self->{mode} = '>'; 89 } 90 91 $self->{autoflush} = $p{autoflush}; 92 93 $self->_open_file() unless $p{close_after_write}; 94 95} 96 97sub _open_file { 98 my $self = shift; 99 100 open my $fh, $self->{mode}, $self->{filename} 101 or die "Cannot write to '$self->{filename}': $!"; 102 103 if ( $self->{autoflush} ) { 104 my $oldfh = select $fh; 105 $| = 1; 106 select $oldfh; 107 } 108 109 if ( $self->{permissions} 110 && !$self->{chmodded} ) { 111 my $current_mode = ( stat $self->{filename} )[2] & 07777; 112 if ( $current_mode ne $self->{permissions} ) { 113 chmod $self->{permissions}, $self->{filename} 114 or die 115 "Cannot chmod $self->{filename} to $self->{permissions}: $!"; 116 } 117 118 $self->{chmodded} = 1; 119 } 120 121 if ( $self->{binmode} ) { 122 binmode $fh, $self->{binmode}; 123 } 124 125 $self->{fh} = $fh; 126} 127 128sub log_message { 129 my $self = shift; 130 my %p = @_; 131 132 if ( $self->{close} ) { 133 $self->_open_file; 134 } 135 136 my $fh = $self->{fh}; 137 138 if ( $self->{syswrite} ) { 139 defined syswrite( $fh, $p{message} ) 140 or die "Cannot write to '$self->{filename}': $!"; 141 } 142 else { 143 print $fh $p{message} 144 or die "Cannot write to '$self->{filename}': $!"; 145 } 146 147 if ( $self->{close} ) { 148 close $fh 149 or die "Cannot close '$self->{filename}': $!"; 150 } 151} 152 153sub DESTROY { 154 my $self = shift; 155 156 if ( $self->{fh} ) { 157 my $fh = $self->{fh}; 158 close $fh if openhandle($fh); 159 } 160} 161 1621; 163 164# ABSTRACT: Object for logging to files 165 166__END__ 167 168=pod 169 170=head1 NAME 171 172Log::Dispatch::File - Object for logging to files 173 174=head1 VERSION 175 176version 2.34 177 178=head1 SYNOPSIS 179 180 use Log::Dispatch; 181 182 my $log = Log::Dispatch->new( 183 outputs => [ 184 [ 185 'File', 186 min_level => 'info', 187 filename => 'Somefile.log', 188 mode => '>>', 189 newline => 1 190 ] 191 ], 192 ); 193 194 $log->emerg("I've fallen and I can't get up"); 195 196=head1 DESCRIPTION 197 198This module provides a simple object for logging to files under the 199Log::Dispatch::* system. 200 201Note that a newline will I<not> be added automatically at the end of a message 202by default. To do that, pass C<< newline => 1 >>. 203 204=head1 CONSTRUCTOR 205 206The constructor takes the following parameters in addition to the standard 207parameters documented in L<Log::Dispatch::Output>: 208 209=over 4 210 211=item * filename ($) 212 213The filename to be opened for writing. 214 215=item * mode ($) 216 217The mode the file should be opened with. Valid options are 'write', 218'>', 'append', '>>', or the relevant constants from Fcntl. The 219default is 'write'. 220 221=item * binmode ($) 222 223A layer name to be passed to binmode, like ":encoding(UTF-8)" or ":raw". 224 225=item * close_after_write ($) 226 227Whether or not the file should be closed after each write. This 228defaults to false. 229 230If this is true, then the mode will always be append, so that the file is not 231re-written for each new message. 232 233=item * autoflush ($) 234 235Whether or not the file should be autoflushed. This defaults to true. 236 237=item * syswrite ($) 238 239Whether or not to perform the write using L<perlfunc/syswrite>(), 240as opposed to L<perlfunc/print>(). This defaults to false. 241The usual caveats and warnings as documented in L<perlfunc/syswrite> apply. 242 243=item * permissions ($) 244 245If the file does not already exist, the permissions that it should 246be created with. Optional. The argument passed must be a valid 247octal value, such as 0600 or the constants available from Fcntl, like 248S_IRUSR|S_IWUSR. 249 250See L<perlfunc/chmod> for more on potential traps when passing octal 251values around. Most importantly, remember that if you pass a string 252that looks like an octal value, like this: 253 254 my $mode = '0644'; 255 256Then the resulting file will end up with permissions like this: 257 258 --w----r-T 259 260which is probably not what you want. 261 262=back 263 264=head1 AUTHOR 265 266Dave Rolsky <autarch@urth.org> 267 268=head1 COPYRIGHT AND LICENSE 269 270This software is Copyright (c) 2011 by Dave Rolsky. 271 272This is free software, licensed under: 273 274 The Artistic License 2.0 (GPL Compatible) 275 276=cut 277