root/Log-Dispatch-DBI/trunk/lib/Log/Dispatch/DBI.pm

Revision 353 (checked in by miyagawa, 19 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Log::Dispatch::DBI;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.01';
6
7 require Log::Dispatch;
8
9 use base qw(Log::Dispatch::Output);
10 use fields qw(dbh sth table _mine);
11
12 use DBI;
13
14 sub new {
15     my($proto, %params) = @_;
16     my $class = ref $proto || $proto;
17
18     my $self = do {
19         no strict 'refs';
20         bless [ \%{"$class\::FIELDS"} ], $class;
21     };
22     $self->_basic_init(%params);
23     $self->_init(%params);
24
25     return $self;
26 }
27
28 sub _init {
29     my Log::Dispatch::DBI $self = shift;
30     my %params = @_;
31
32     # set parameters
33     if ($params{dbh}) {
34         $self->{dbh} = $params{dbh};
35     } else {
36         $self->{dbh} = DBI->connect(@params{qw(datasource username password)})
37             or die $DBI::errstr;
38         $self->{_mine} = 1;
39     }
40
41     $self->{table} = $params{table} || 'log';
42     $self->{sth} = $self->create_statement;
43 }
44
45 sub create_statement {
46     my Log::Dispatch::DBI $self = shift;
47     return $self->{dbh}->prepare(<<"SQL");
48 INSERT INTO $self->{table} (level, message) VALUES (?, ?)
49 SQL
50     ;
51 }
52
53 sub log_message {
54     my Log::Dispatch::DBI $self = shift;
55     my %params = @_;
56     $self->{sth}->execute(@params{qw(level message)});
57 }
58
59 sub DESTROY {
60     my Log::Dispatch::DBI $self = shift;
61     if ($self->{_mine} && $self->{dbh}) {
62         $self->{dbh}->disconnect;
63     }
64 }
65
66 1;
67 __END__
68
69 =head1 NAME
70
71 Log::Dispatch::DBI - Class for logging to database via DBI interface
72
73 =head1 SYNOPSIS
74
75   use Log::Dispatch::DBI;
76
77   my $log = Log::Dispatch::DBI->new(
78       name       => 'dbi',
79       min_level  => 'info',
80       datasource => 'dbi:mysql:log',
81       username   => 'user',
82       password   => 'password',
83       table      => 'logging',
84   );
85
86   # Or, if your handle is alreaady connected
87   $log = Log::Dispatch::DBI->new(
88       name => 'dbi',
89       min_level => 'info',
90       dbh  => $dbh,
91   );
92
93   $log->log(level => 'emergency', messsage => 'something BAD happened');
94
95 =head1 DESCRIPTION
96
97 Log::Dispatch::DBI is a subclass of Log::Dispatch::Output, which
98 inserts logging output into relational database using DBI interface.
99
100 =head1 METHODS
101
102 =over 4
103
104 =item new
105
106   $log = Log::Dispatch::DBI->new(%params);
107
108 This method takes a hash of parameters. The following options are valid:
109
110 =item -- name, min_level, max_level, callbacks
111
112 Same as various Log::Dispatch::* classes.
113
114 =item -- dbh
115
116 Database handle where Log::Dispatch::DBI throws log message.
117
118 =item -- datasource, username, password
119
120 If database connection is not yet established, put the DSN, username
121 and password for DBI connect method. Destructor method of
122 Log::Dispatch::DBI disconnects database handle, if the handle is made
123 inside by these parameters. (The method does not disconnect the handle
124 if it's supplied with C<dbh> parameter.)
125
126 =item -- table
127
128 Table name for logging. default is B<log>.
129
130 =item log_message
131
132 inherited from Log::Dispatch::Output.
133
134 =back
135
136 =head1 TABLE SCHEMA
137
138 Maybe something like this for MySQL.
139
140   CREATE TABLE log (
141       id        int unsigned NOT NULL PRIMARY KEY AUTO_INCREMENT,
142       level     varchar(9) NOT NULL,
143       message   text NOT NULL,
144       timestamp timestamp
145   );
146
147 For example,
148
149   $log->log(level => 'info', message => 'too bad');
150
151 will execute the following SQL:
152
153   INSERT INTO log (level, message) VALUES ('info', 'too bad');
154
155 If you change this behaviour, what you should do is to subclass
156 Log::Dispatch::DBI and override C<create_statement> and C<log_message>
157 method.
158
159 =head1 AUTHOR
160
161 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
162
163 This library is free software; you can redistribute it and/or modify
164 it under the same terms as Perl itself.
165
166 =head1 SEE ALSO
167
168 L<Log::Dispatch>, L<DBI>, L<Log::Dispatch::Config>
169
170 =cut
Note: See TracBrowser for help on using the browser.