1package Log::Log4perl::Appender::DBI; 2 3our @ISA = qw(Log::Log4perl::Appender); 4 5use Carp; 6 7use strict; 8use DBI; 9 10sub new { 11 my($proto, %p) = @_; 12 my $class = ref $proto || $proto; 13 14 my $self = bless {}, $class; 15 16 $self->_init(%p); 17 18 my %defaults = ( 19 reconnect_attempts => 1, 20 reconnect_sleep => 0, 21 ); 22 23 for (keys %defaults) { 24 if(exists $p{$_}) { 25 $self->{$_} = $p{$_}; 26 } else { 27 $self->{$_} = $defaults{$_}; 28 } 29 } 30 31 #e.g. 32 #log4j.appender.DBAppndr.params.1 = %p 33 #log4j.appender.DBAppndr.params.2 = %5.5m 34 foreach my $pnum (keys %{$p{params}}){ 35 $self->{bind_value_layouts}{$pnum} = 36 Log::Log4perl::Layout::PatternLayout->new({ 37 ConversionPattern => {value => $p{params}->{$pnum}}, 38 undef_column_value => undef, 39 }); 40 } 41 #'bind_value_layouts' now contains a PatternLayout 42 #for each parameter heading for the Sql engine 43 44 $self->{SQL} = $p{sql}; #save for error msg later on 45 46 $self->{MAX_COL_SIZE} = $p{max_col_size}; 47 48 $self->{BUFFERSIZE} = $p{bufferSize} || 1; 49 50 if ($p{usePreparedStmt}) { 51 $self->{sth} = $self->create_statement($p{sql}); 52 $self->{usePreparedStmt} = 1; 53 }else{ 54 $self->{layout} = Log::Log4perl::Layout::PatternLayout->new({ 55 ConversionPattern => {value => $p{sql}}, 56 undef_column_value => undef, 57 }); 58 } 59 60 if ($self->{usePreparedStmt} && $self->{bufferSize}){ 61 warn "Log4perl: you've defined both usePreparedStmt and bufferSize \n". 62 "in your appender '$p{name}'--\n". 63 "I'm going to ignore bufferSize and just use a prepared stmt\n"; 64 } 65 66 return $self; 67} 68 69 70sub _init { 71 my $self = shift; 72 my %params = @_; 73 74 if ($params{dbh}) { 75 $self->{dbh} = $params{dbh}; 76 } else { 77 $self->{connect} = sub { 78 DBI->connect(@params{qw(datasource username password)}, 79 {PrintError => 0, $params{attrs} ? %{$params{attrs}} : ()}) 80 or croak "Log4perl: $DBI::errstr"; 81 }; 82 $self->{dbh} = $self->{connect}->(); 83 $self->{_mine} = 1; 84 } 85} 86 87sub create_statement { 88 my ($self, $stmt) = @_; 89 90 $stmt || croak "Log4perl: sql not set in Log4perl::Appender::DBI"; 91 92 return $self->{dbh}->prepare($stmt) || croak "Log4perl: DBI->prepare failed $DBI::errstr\n$stmt"; 93 94} 95 96 97sub log { 98 my $self = shift; 99 my %p = @_; 100 101 #%p is 102 # { name => $appender_name, 103 # level => loglevel 104 # message => $message, 105 # log4p_category => $category, 106 # log4p_level => $level,); 107 # }, 108 109 #getting log4j behavior with no specified ConversionPattern 110 chomp $p{message} unless ref $p{message}; 111 112 113 my $qmarks = $self->calculate_bind_values(\%p); 114 115 116 if ($self->{usePreparedStmt}) { 117 118 $self->query_execute($self->{sth}, @$qmarks); 119 120 }else{ 121 122 #first expand any %x's in the statement 123 my $stmt = $self->{layout}->render( 124 $p{message}, 125 $p{log4p_category}, 126 $p{log4p_level}, 127 5 + $Log::Log4perl::caller_depth, 128 ); 129 130 push @{$self->{BUFFER}}, $stmt, $qmarks; 131 132 $self->check_buffer(); 133 } 134} 135 136sub query_execute { 137 my($self, $sth, @qmarks) = @_; 138 139 my $errstr = "[no error]"; 140 141 for my $attempt (0..$self->{reconnect_attempts}) { 142 #warn "Exe: @qmarks"; # TODO 143 if(! $sth->execute(@qmarks)) { 144 145 # save errstr because ping() would override it [RT 56145] 146 $errstr = $self->{dbh}->errstr(); 147 148 # Exe failed -- was it because we lost the DB 149 # connection? 150 if($self->{dbh}->ping()) { 151 # No, the connection is ok, we failed because there's 152 # something wrong with the execute(): Bad SQL or 153 # missing parameters or some such). Abort. 154 croak "Log4perl: DBI appender error: '$errstr'"; 155 } 156 157 if($attempt == $self->{reconnect_attempts}) { 158 croak "Log4perl: DBI appender failed to " . 159 ($self->{reconnect_attempts} == 1 ? "" : "re") . 160 "connect " . 161 "to database after " . 162 "$self->{reconnect_attempts} attempt" . 163 ($self->{reconnect_attempts} == 1 ? "" : "s") . 164 " (last error error was [$errstr]"; 165 } 166 if(! $self->{dbh}->ping()) { 167 # Ping failed, try to reconnect 168 if($attempt) { 169 #warn "Sleeping"; # TODO 170 sleep($self->{reconnect_sleep}) if $self->{reconnect_sleep}; 171 } 172 173 eval { 174 #warn "Reconnecting to DB"; # TODO 175 $self->{dbh} = $self->{connect}->(); 176 }; 177 } 178 179 if ($self->{usePreparedStmt}) { 180 $sth = $self->create_statement($self->{SQL}); 181 $self->{sth} = $sth if $self->{sth}; 182 } else { 183 #warn "Pending stmt: $self->{pending_stmt}"; #TODO 184 $sth = $self->create_statement($self->{pending_stmt}); 185 } 186 187 next; 188 } 189 return 1; 190 } 191 croak "Log4perl: DBI->execute failed $errstr, \n". 192 "on $self->{SQL}\n @qmarks"; 193} 194 195sub calculate_bind_values { 196 my ($self, $p) = @_; 197 198 my @qmarks; 199 my $user_ph_idx = 0; 200 201 my $i=0; 202 203 if ($self->{bind_value_layouts}) { 204 205 my $prev_pnum = 0; 206 my $max_pnum = 0; 207 208 my @pnums = sort {$a <=> $b} keys %{$self->{bind_value_layouts}}; 209 $max_pnum = $pnums[-1]; 210 211 #Walk through the integers for each possible bind value. 212 #If it doesn't have a layout assigned from the config file 213 #then shift it off the array from the $log call 214 #This needs to be reworked now that we always get an arrayref? --kg 1/2003 215 foreach my $pnum (1..$max_pnum){ 216 my $msg; 217 218 #we've got a bind_value_layout to fill the spot 219 if ($self->{bind_value_layouts}{$pnum}){ 220 $msg = $self->{bind_value_layouts}{$pnum}->render( 221 $p->{message}, 222 $p->{log4p_category}, 223 $p->{log4p_level}, 224 5 + $Log::Log4perl::caller_depth, 225 ); 226 227 #we don't have a bind_value_layout, so get 228 #a message bit 229 }elsif (ref $p->{message} eq 'ARRAY' && @{$p->{message}}){ 230 #$msg = shift @{$p->{message}}; 231 $msg = $p->{message}->[$i++]; 232 233 #here handle cases where we ran out of message bits 234 #before we ran out of bind_value_layouts, just keep going 235 }elsif (ref $p->{message} eq 'ARRAY'){ 236 $msg = undef; 237 $p->{message} = undef; 238 239 #here handle cases where we didn't get an arrayref 240 #log the message in the first placeholder and nothing in the rest 241 }elsif (! ref $p->{message} ){ 242 $msg = $p->{message}; 243 $p->{message} = undef; 244 245 } 246 247 if ($self->{MAX_COL_SIZE} && 248 length($msg) > $self->{MAX_COL_SIZE}){ 249 substr($msg, $self->{MAX_COL_SIZE}) = ''; 250 } 251 push @qmarks, $msg; 252 } 253 } 254 255 #handle leftovers 256 if (ref $p->{message} eq 'ARRAY' && @{$p->{message}} ) { 257 #push @qmarks, @{$p->{message}}; 258 push @qmarks, @{$p->{message}}[$i..@{$p->{message}}-1]; 259 260 } 261 262 return \@qmarks; 263} 264 265 266sub check_buffer { 267 my $self = shift; 268 269 return unless ($self->{BUFFER} && ref $self->{BUFFER} eq 'ARRAY'); 270 271 if (scalar @{$self->{BUFFER}} >= $self->{BUFFERSIZE} * 2) { 272 273 my ($sth, $stmt, $prev_stmt); 274 275 $prev_stmt = ""; # Init to avoid warning (ms 5/10/03) 276 277 while (@{$self->{BUFFER}}) { 278 my ($stmt, $qmarks) = splice (@{$self->{BUFFER}},0,2); 279 280 $self->{pending_stmt} = $stmt; 281 282 #reuse the sth if the stmt doesn't change 283 if ($stmt ne $prev_stmt) { 284 $sth->finish if $sth; 285 $sth = $self->create_statement($stmt); 286 } 287 288 $self->query_execute($sth, @$qmarks); 289 290 $prev_stmt = $stmt; 291 292 } 293 294 $sth->finish; 295 296 my $dbh = $self->{dbh}; 297 298 if ($dbh && ! $dbh->{AutoCommit}) { 299 $dbh->commit; 300 } 301 } 302} 303 304sub DESTROY { 305 my $self = shift; 306 307 $self->{BUFFERSIZE} = 1; 308 309 $self->check_buffer(); 310 311 if ($self->{_mine} && $self->{dbh}) { 312 $self->{dbh}->disconnect; 313 } 314} 315 316 3171; 318 319__END__ 320 321=head1 NAME 322 323Log::Log4perl::Appender::DBI - implements appending to a DB 324 325=head1 SYNOPSIS 326 327 my $config = q{ 328 log4j.category = WARN, DBAppndr 329 log4j.appender.DBAppndr = Log::Log4perl::Appender::DBI 330 log4j.appender.DBAppndr.datasource = DBI:CSV:f_dir=t/tmp 331 log4j.appender.DBAppndr.username = bobjones 332 log4j.appender.DBAppndr.password = 12345 333 log4j.appender.DBAppndr.sql = \ 334 insert into log4perltest \ 335 (loglevel, custid, category, message, ipaddr) \ 336 values (?,?,?,?,?) 337 log4j.appender.DBAppndr.params.1 = %p 338 #2 is custid from the log() call 339 log4j.appender.DBAppndr.params.3 = %c 340 #4 is the message from log() 341 #5 is ipaddr from log() 342 343 log4j.appender.DBAppndr.usePreparedStmt = 1 344 #--or-- 345 log4j.appender.DBAppndr.bufferSize = 2 346 347 #just pass through the array of message items in the log statement 348 log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::NoopLayout 349 log4j.appender.DBAppndr.warp_message = 0 350 351 #driver attributes support 352 log4j.appender.DBAppndr.attrs.f_encoding = utf8 353 }; 354 355 $logger->warn( $custid, 'big problem!!', $ip_addr ); 356 357=head1 CAVEAT 358 359This is a very young module and there are a lot of variations 360in setups with different databases and connection methods, 361so make sure you test thoroughly! Any feedback is welcome! 362 363=head1 DESCRIPTION 364 365This is a specialized Log::Dispatch object customized to work with 366log4perl and its abilities, originally based on Log::Dispatch::DBI 367by Tatsuhiko Miyagawa but with heavy modifications. 368 369It is an attempted compromise between what Log::Dispatch::DBI was 370doing and what log4j's JDBCAppender does. Note the log4j docs say 371the JDBCAppender "is very likely to be completely replaced in the future." 372 373The simplest usage is this: 374 375 log4j.category = WARN, DBAppndr 376 log4j.appender.DBAppndr = Log::Log4perl::Appender::DBI 377 log4j.appender.DBAppndr.datasource = DBI:CSV:f_dir=t/tmp 378 log4j.appender.DBAppndr.username = bobjones 379 log4j.appender.DBAppndr.password = 12345 380 log4j.appender.DBAppndr.sql = \ 381 INSERT INTO logtbl \ 382 (loglevel, message) \ 383 VALUES ('%c','%m') 384 385 log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::PatternLayout 386 387 388 $logger->fatal('fatal message'); 389 $logger->warn('warning message'); 390 391 =============================== 392 |FATAL|fatal message | 393 |WARN |warning message | 394 =============================== 395 396 397But the downsides to that usage are: 398 399=over 4 400 401=item * 402 403You'd better be darn sure there are not quotes in your log message, or your 404insert could have unforseen consequences! This is a very insecure way to 405handle database inserts, using place holders and bind values is much better, 406keep reading. (Note that the log4j docs warn "Be careful of quotes in your 407messages!") B<*>. 408 409=item * 410 411It's not terribly high-performance, a statement is created and executed 412for each log call. 413 414=item * 415 416The only run-time parameter you get is the %m message, in reality 417you probably want to log specific data in specific table columns. 418 419=back 420 421So let's try using placeholders, and tell the logger to create a 422prepared statement handle at the beginning and just reuse it 423(just like Log::Dispatch::DBI does) 424 425 426 log4j.appender.DBAppndr.sql = \ 427 INSERT INTO logtbl \ 428 (custid, loglevel, message) \ 429 VALUES (?,?,?) 430 431 #--------------------------------------------------- 432 #now the bind values: 433 #1 is the custid 434 log4j.appender.DBAppndr.params.2 = %p 435 #3 is the message 436 #--------------------------------------------------- 437 438 log4j.appender.DBAppndr.layout = Log::Log4perl::Layout::NoopLayout 439 log4j.appender.DBAppndr.warp_message = 0 440 441 log4j.appender.DBAppndr.usePreparedStmt = 1 442 443 444 $logger->warn( 1234, 'warning message' ); 445 446 447Now see how we're using the '?' placeholders in our statement? This 448means we don't have to worry about messages that look like 449 450 invalid input: 1234';drop table custid; 451 452fubaring our database! 453 454Normally a list of things in the logging statement gets concatenated into 455a single string, but setting C<warp_message> to 0 and using the 456NoopLayout means that in 457 458 $logger->warn( 1234, 'warning message', 'bgates' ); 459 460the individual list values will still be available for the DBI appender later 461on. (If C<warp_message> is not set to 0, the default behavior is to 462join the list elements into a single string. If PatternLayout or SimpleLayout 463are used, their attempt to C<render()> your layout will result in something 464like "ARRAY(0x841d8dc)" in your logs. More information on C<warp_message> 465is in Log::Log4perl::Appender.) 466 467In your insert SQL you can mix up '?' placeholders with conversion specifiers 468(%c, %p, etc) as you see fit--the logger will match the question marks to 469params you've defined in the config file and populate the rest with values 470from your list. If there are more '?' placeholders than there are values in 471your message, it will use undef for the rest. For instance, 472 473 log4j.appender.DBAppndr.sql = \ 474 insert into log4perltest \ 475 (loglevel, message, datestr, subpoena_id)\ 476 values (?,?,?,?) 477 log4j.appender.DBAppndr.params.1 = %p 478 log4j.appender.DBAppndr.params.3 = %d 479 480 log4j.appender.DBAppndr.warp_message=0 481 482 483 $logger->info('arrest him!', $subpoena_id); 484 485results in the first '?' placholder being bound to %p, the second to 486"arrest him!", the third to the date from "%d", and the fourth to your 487$subpoenaid. If you forget the $subpoena_id and just log 488 489 $logger->info('arrest him!'); 490 491then you just get undef in the fourth column. 492 493 494If the logger statement is also being handled by other non-DBI appenders, 495they will just join the list into a string, joined with 496C<$Log::Log4perl::JOIN_MSG_ARRAY_CHAR> (default is an empty string). 497 498And see the C<usePreparedStmt>? That creates a statement handle when 499the logger object is created and just reuses it. That, however, may 500be problematic for long-running processes like webservers, in which case 501you can use this parameter instead 502 503 log4j.appender.DBAppndr.bufferSize=2 504 505This copies log4j's JDBCAppender's behavior, it saves up that many 506log statements and writes them all out at once. If your INSERT 507statement uses only ? placeholders and no %x conversion specifiers 508it should be quite efficient because the logger can re-use the 509same statement handle for the inserts. 510 511If the program ends while the buffer is only partly full, the DESTROY 512block should flush the remaining statements, if the DESTROY block 513runs of course. 514 515* I<As I was writing this, Danko Mannhaupt was coming out with his 516improved log4j JDBCAppender (http://www.mannhaupt.com/danko/projects/) 517which overcomes many of the drawbacks of the original JDBCAppender.> 518 519=head1 DESCRIPTION 2 520 521Or another way to say the same thing: 522 523The idea is that if you're logging to a database table, you probably 524want specific parts of your log information in certain columns. To this 525end, you pass an list to the log statement, like 526 527 $logger->warn('big problem!!',$userid,$subpoena_nr,$ip_addr); 528 529and the array members drop into the positions defined by the placeholders 530in your SQL statement. You can also define information in the config 531file like 532 533 log4j.appender.DBAppndr.params.2 = %p 534 535in which case those numbered placeholders will be filled in with 536the specified values, and the rest of the placeholders will be 537filled in with the values from your log statement's array. 538 539=head1 MISC PARAMETERS 540 541 542=over 4 543 544=item usePreparedStmt 545 546See above. 547 548=item warp_message 549 550see Log::Log4perl::Appender 551 552=item max_col_size 553 554If you're used to just throwing debugging messages like huge stacktraces 555into your logger, some databases (Sybase's DBD!!) may suprise you 556by choking on data size limitations. Normally, the data would 557just be truncated to fit in the column, but Sybases's DBD it turns out 558maxes out at 255 characters. Use this parameter in such a situation 559to truncate long messages before they get to the INSERT statement. 560 561=back 562 563=head1 CHANGING DBH CONNECTIONS (POOLING) 564 565If you want to get your dbh from some place in particular, like 566maybe a pool, subclass and override _init() and/or create_statement(), 567for instance 568 569 sub _init { 570 ; #no-op, no pooling at this level 571 } 572 sub create_statement { 573 my ($self, $stmt) = @_; 574 575 $stmt || croak "Log4perl: sql not set in ".__PACKAGE__; 576 577 return My::Connections->getConnection->prepare($stmt) 578 || croak "Log4perl: DBI->prepare failed $DBI::errstr\n$stmt"; 579 } 580 581 582=head1 LIFE OF CONNECTIONS 583 584If you're using C<log4j.appender.DBAppndr.usePreparedStmt> 585this module creates an sth when it starts and keeps it for the life 586of the program. For long-running processes (e.g. mod_perl), connections 587might go stale, but if C<Log::Log4perl::Appender::DBI> tries to write 588a message and figures out that the DB connection is no longer working 589(using DBI's ping method), it will reconnect. 590 591The reconnection process can be controlled by two parameters, 592C<reconnect_attempts> and C<reconnect_sleep>. C<reconnect_attempts> 593specifies the number of reconnections attempts the DBI appender 594performs until it gives up and dies. C<reconnect_sleep> is the 595time between reconnection attempts, measured in seconds. 596C<reconnect_attempts> defaults to 1, C<reconnect_sleep> to 0. 597 598Alternatively, use C<Apache::DBI> or C<Apache::DBI::Cache> and read 599CHANGING DB CONNECTIONS above. 600 601Note that C<Log::Log4perl::Appender::DBI> holds one connection open 602for every appender, which might be too many. 603 604=head1 SEE ALSO 605 606L<Log::Dispatch::DBI> 607 608L<Log::Log4perl::JavaMap::JDBCAppender> 609 610=head1 LICENSE 611 612Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt> 613and Kevin Goess E<lt>cpan@goess.orgE<gt>. 614 615This library is free software; you can redistribute it and/or modify 616it under the same terms as Perl itself. 617 618=head1 AUTHOR 619 620Please contribute patches to the project on Github: 621 622 http://github.com/mschilli/log4perl 623 624Send bug reports or requests for enhancements to the authors via our 625 626MAILING LIST (questions, bug reports, suggestions/patches): 627log4perl-devel@lists.sourceforge.net 628 629Authors (please contact them via the list above, not directly): 630Mike Schilli <m@perlmeister.com>, 631Kevin Goess <cpan@goess.org> 632 633Contributors (in alphabetical order): 634Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton 635Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony 636Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy 637Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles, 638Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik 639Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang. 640 641