Log::Handler::Output::DBI - Log messages to a database.

Log-Handler documentation Contained in the Log-Handler distribution.

Index

Code Index:

NAME

Top

Log::Handler::Output::DBI - Log messages to a database.

SYNOPSIS

Top

    use Log::Handler::Output::DBI;

    my $db = Log::Handler::Output::DBI->new(
        # database source
        database    => "database",
        driver      => "mysql",
        host        => "127.0.0.1",
        port        => 3306,

        # or with "dbname" instead of "database"
        dbname      => "database",
        driver      => "Pg",
        host        => "127.0.0.1",
        port        => 5432,

        # or with data_source
        data_source => "dbi:mysql:database=database;host=127.0.0.1;port=3306",

        # Username and password
        user        => "user",
        password    => "password",

        # debugging
        debug       => 1,

        # table, columns and values (as string)
        table       => "messages",
        columns     => "level ctime cdate pid hostname progname message",
        values      => "%level %time %date %pid %hostname %progname %message",

        # table, columns and values (as array reference)
        table       => "messages",
        columns     => [ qw/level ctime cdate pid hostname progname message/ ],
        values      => [ qw/%level %time %date %pid %hostname %progname %message/ ],

        # table, columns and values (your own statement)
        statement   => "insert into messages (level,ctime,cdate,pid,hostname,progname,message) values (?,?,?,?,?,?,?)",
        values      => [ qw/%level %time %date %pid %hostname %progname %message/ ],

        # if you like persistent connections and want to re-connect
        persistent  => 1,
    );

    my %message = (
        level       => "ERROR",
        time        => "10:12:13",
        date        => "1999-12-12",
        pid         => $$,
        hostname    => "localhost",
        progname    => $0,
        message     => "an error here"
    );

    $db->log(\%message);

DESCRIPTION

Top

With this output you can insert messages into a database table.

METHODS

Top

new()

Call new() to create a new Log::Handler::Output::DBI object.

The following options are possible:

data_source

Set the dsn (data source name).

You can use this parameter instead of database, driver, host and port.

database or dbname

Pass the database name.

driver

Pass the database driver.

host

Pass the hostname where the database is running.

port

Pass the port where the database is listened.

user

Pass the database user for the connect.

password

Pass the users password.

table and columns

With this options you can pass the table name for the insert and the columns. You can pass the columns as string or as array. Example:

    # the table name
    table => "messages",

    # columns as string
    columns => "level, ctime, cdate, pid, hostname, progname, message",

    # columns as array
    columns => [ qw/level ctime cdate pid hostname progname message/ ],

The statement would created as follows

    insert into message (level, ctime, cdate, pid, hostname, progname, mtime, message)
                 values (?,?,?,?,?,?,?)
statement

With this option you can pass your own statement if you don't want to you the options table and columns.

    statement => "insert into message (level, ctime, cdate, pid, hostname, progname, mtime, message)"
                 ." values (?,?,?,?,?,?,?)"
values

With this option you have to set the values for the insert.

        values => "%level, %time, %date, %pid, %hostname, %progname, %message",

        # or

        values => [ qw/%level %time %date %pid %hostname %progname %message/ ],

The placeholders are identical with the pattern names that you have to pass with the option message_pattern from Log::Handler.

    %L   level
    %T   time
    %D   date
    %P   pid
    %H   hostname
    %N   newline
    %C   caller
    %p   package
    %f   filename
    %l   line
    %s   subroutine
    %S   progname
    %r   runtime
    %t   mtime
    %m   message

Take a look to the documentation of Log::Handler for all possible patterns.

persistent

With this option you can enable or disable a persistent database connection and re-connect if the connection was lost.

This option is set to 1 on default.

dbi_params

This option is useful if you want to pass arguments to DBI. The default is set to

    {
        PrintError => 0,
        AutoCommit => 1
    }

PrintError is deactivated because this would print error messages as warnings to STDERR.

You can pass your own arguments - and overwrite it - with

    dbi_params => { PrintError => 1, AutoCommit => 0 }
debug

With this option it's possible to enable debugging. The information can be intercepted with $SIG{__WARN__}.

log()

Log a message to the database.

    my $db = Log::Handler::Output::DBI->new(
        database   => "database",
        driver     => "mysql",
        user       => "user",
        password   => "password",
        host       => "127.0.0.1",
        port       => 3306,
        table      => "messages",
        columns    => [ qw/level ctime message/ ],
        values     => [ qw/%level %time %message/ ],
        persistent => 1,
    );

    $db->log(
        message => "your message",
        level   => "INFO",
        time    => "2008-10-10 10:12:23",
    );

Or you can connect to the database yourself. You should notice that if the database connection lost then the logger can't re-connect to the database and would return an error. Use dbi_handle at your own risk.

    my $dbh = DBI->connect(...);

    my $db = Log::Handler::Output::DBI->new(
        dbi_handle => $dbh,
        table      => "messages",
        columns    => [ qw/level ctime message/ ],
        values     => [ qw/%level %time %message/ ],
    );

connect()

Connect to the database.

disconnect()

Disconnect from the database.

validate()

Validate a configuration.

reload()

Reload with a new configuration.

errstr()

This function returns the last error message.

PREREQUISITES

Top

    Carp
    Params::Validate
    DBI
    your DBI driver you want to use

EXPORTS

Top

No exports.

REPORT BUGS

Top

Please report all bugs to <jschulz.cpan(at)bloonix.de>.

If you send me a mail then add Log::Handler into the subject.

AUTHOR

Top

Jonny Schulz <jschulz.cpan(at)bloonix.de>.

COPYRIGHT

Top

Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Log-Handler documentation Contained in the Log-Handler distribution. 
package Log::Handler::Output::DBI;

use strict;
use warnings;
use DBI;
use Carp;
use Params::Validate qw();

our $VERSION = "0.11";
our $ERRSTR  = "";

sub new {
    my $class = shift;
    my $opts  = $class->_validate(@_);
    my $self  = bless $opts, $class;

    if ($self->{debug}) {
        warn "Create a new Log::Handler::Output::DBI object";
    }

    return $self;
}

sub log {
    my $self    = shift;
    my $message = @_ > 1 ? {@_} : shift;
    my @values  = ();

    foreach my $v (@{$self->{values}}) {
        if (ref($v) eq "CODE") {
            push @values, &$v();
        } elsif ($v =~ /^%(.+)/ && exists $message->{$1}) {
            push @values, $message->{$1};
        } else {
            push @values, $v;
        }
    }

    if ($self->{debug}) {
        warn "execute: ".@values." bind values";
    }

    $self->connect or return undef;

    if ( ! $self->{sth}->execute(@values) ) {
        return $self->_raise_error("DBI execute error: ".DBI->errstr);
    }

    if (!$self->{persistent} && !$self->{dbi_handle}) {
        $self->disconnect or return undef;
    }

    return 1;
}

sub connect {
    my $self = shift;

    if ($self->{persistent} && $self->{dbh}) {
        if ($self->{use_ping}) {
            if ($self->{dbh}->ping) {
                return 1;
            }
        } else {
            eval { $self->{dbh}->do($self->{pingstmt}) or die DBI->errstr };
            return 1 unless $@;
        }
    }

    if ($self->{debug}) {
        warn "Connect to the database: $self->{cstr}->[0] ...";
    }

    my $dbh;

    if ($self->{dbi_handle}) {
        # If db ping failed and dbi_handle and dbi is set
        # then it seems that the database is down.
        if ($self->{dbi}) {
            return $self->_raise_error("dbi_handle - lost connection");
        }
        $dbh = $self->{dbi_handle};
    } else {
        $dbh = DBI->connect(@{$self->{cstr}})
            or return $self->_raise_error("DBI connect error: ".DBI->errstr);
    }

    my $sth = $dbh->prepare($self->{statement})
        or return $self->_raise_error("DBI prepare error: ".$dbh->errstr);

    $self->{dbh} = $dbh;
    $self->{sth} = $sth;

    return 1;
}

sub disconnect {
    my $self = shift;

    if ($self->{sth}) {
        $self->{sth}->finish
            or return $self->_raise_error("DBI finish error: ".$self->{sth}->errstr);

        delete $self->{sth};
    }

    if ($self->{dbh}) {
        if ($self->{debug}) {
            warn "Disconnect from database";
        }

        $self->{dbh}->disconnect
            or return $self->_raise_error("DBI disconnect error: ".DBI->errstr);;

        delete $self->{dbh};
    }

    return 1;
}

sub validate {
    my $self = shift;
    my $opts = ();

    eval { $opts = $self->_validate(@_) };

    if ($@) {
        return $self->_raise_error($@);
    }

    return $opts;
}

sub reload {
    my $self = shift;
    my $opts = $self->validate(@_);

    if (!$opts) {
        return undef;
    }

    $self->disconnect;

    foreach my $key (keys %$opts) {
        $self->{$key} = $opts->{$key};
    }

    return 1;
}

sub errstr {
    return $ERRSTR;
}

#
# private stuff
#

sub _validate {
    my $class = shift;

    my %options = Params::Validate::validate(@_, {
        data_source => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        database => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        dbname => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        driver => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        user => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        password => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        host => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        port => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        table => {
            type => Params::Validate::SCALAR,
            depends => [ "columns" ],
            optional => 1,
        },
        columns => {
            type => Params::Validate::SCALAR | Params::Validate::ARRAYREF,
            depends => [ "table" ],
            optional => 1,
        },
        values => {
            type => Params::Validate::SCALAR | Params::Validate::ARRAYREF,
        },
        statement => {
            type => Params::Validate::SCALAR,
            optional => 1,
        },
        persistent => {
            type => Params::Validate::SCALAR,
            default => 1,
        },
        dbi_params => {
            type => Params::Validate::HASHREF,
            default => { PrintError => 0, AutoCommit => 1 },
        },
        use_ping => {
            type => Params::Validate::SCALAR,
            regex => qr/^[01]\z/,
            default => 0,
        },
        debug => {
            type => Params::Validate::SCALAR,
            regex => qr/^[01]\z/,
            default => 0,
        },
    });

    if (!$options{table} && !$options{statement}) {
        Carp::croak "Missing one of the mandatory options: 'statement' or 'table' and 'columns'";
    }

    # build the connect string (data source name)
    my @cstr = ();

    if (defined $options{data_source}) {
        @cstr = ($options{data_source});
    } elsif ($options{driver} && ($options{database} || $options{dbname})) {
        $cstr[0] = "dbi:$options{driver}:";

        if ($options{database}) {
            $cstr[0] .= "database=$options{database}";
        } else {
            $cstr[0] .= "dbname=$options{dbname}";
        }

        if ($options{host}) {
            $cstr[0] .= ";host=$options{host}";
            if ($options{port}) {
                $cstr[0] .= ";port=$options{port}";
            }
        }
    } else {
        Carp::croak "Missing mandatory options data_source or database/dbname";
    }

    if ($options{user}) {
        $cstr[1] = $options{user};
        if ($options{password}) {
            $cstr[2] = $options{password};
        }
    }

    $cstr[3] = $options{dbi_params};
    $options{cstr} = \@cstr;

    # build the statement

    if (!ref($options{values})) {
        $options{values} = [ split /[\s,]+/, $options{values} ];
    }

    if (!$options{statement}) {

        $options{statement} = "insert into $options{table} (";

        if (ref($options{columns})) {
            $options{statement} .= join(",", @{$options{columns}});
        } else {
            $options{statement} .= join(",", split /[\s,]+/, $options{columns});
        }

        $options{statement} .= ") values (";

        my @binds;
        foreach my $v (@{$options{values}}) {
            $v =~ s/^\s+//;
            $v =~ s/\s+\z//;
            push @binds, "?";
        }

        $options{statement} .= join(",", @binds);
        $options{statement} .= ")";
    }

    if ($options{driver} && $options{driver} =~ /oracle/i) {
        $options{pingstmt} = "select 1 from dual";
    } else {
        $options{pingstmt} = "select 1";
    }

    return \%options;
}

sub _raise_error {
    my $self = shift;
    $ERRSTR = shift;
    return undef;
}

1;