4 use base qw( FS::Record );
5 use FS::Record qw( qsearch qsearchs dbdef );
6 use FS::UID qw( dbh driver_name );
10 use FS::upgrade_journal;
15 FS::log - Object methods for log records
21 $record = new FS::log \%hash;
22 $record = new FS::log { 'column' => 'value' };
24 $error = $record->insert;
26 $error = $new_record->replace($old_record);
28 $error = $record->delete;
30 $error = $record->check;
34 An FS::log object represents a log entry. FS::log inherits from
35 FS::Record. The following fields are currently supported:
39 =item lognum - primary key
41 =item _date - Unix timestamp
43 =item agentnum - L<FS::agent> to which the log pertains. If it involves a
44 specific customer, package, service, invoice, or other agent-specific object,
45 this will be set to that agentnum.
47 =item tablename - table name to which the log pertains, if any.
49 =item tablenum - foreign key to that table.
51 =item level - log level: 'debug', 'info', 'warning', 'error', 'critical',
53 =item message - contents of the log entry
63 Creates a new log entry. Use FS::Log instead of calling this directly,
70 =item insert [ CONTEXT... ]
72 Adds this record to the database. If there is an error, returns the error,
73 otherwise returns false.
75 CONTEXT may be a list of context tags to attach to this record.
77 Will send emails according to the conditions in L<FS::log_email>.
82 # not using process_o2m for this, because we don't have a web interface
84 my $error = $self->SUPER::insert;
85 return $error if $error;
87 my $contexts = {}; # for quick checks when sending emails
88 my $context_height = @_; # also for email check
89 foreach ( @_ ) { # ordered from least to most specific
90 my $context = FS::log_context->new({
91 'lognum' => $self->lognum,
94 $error = $context->insert;
95 return $error if $error;
96 $contexts->{$_} = $context_height--;
99 foreach my $log_email (
105 'value' => $self->level,
110 # shouldn't be a lot of log_email records, so not packing these checks into the qsearch
111 next if $log_email->context && !$contexts->{$log_email->context};
112 next if $log_email->context_height && ($contexts->{$log_email->context} > $log_email->context_height);
113 my $msg_template = qsearchs('msg_template',{ 'msgnum' => $log_email->msgnum });
114 unless ($msg_template) {
115 warn "Could not send email when logging, could not load message template for logemailnum " . $log_email->logemailnum;
118 my $emailerror = $msg_template->send(
119 'msgtype' => 'admin',
120 'to' => $log_email->to_addr,
122 'loglevel' => $FS::Log::LEVELS{$self->level} || 'unknown',
123 'logcontext' => join(', ', keys( %$contexts )) || 'unknown',
124 'logmessage' => $self->message,
127 warn "Could not send email when logging: $emailerror" if $emailerror;
132 # these methods can be inherited from FS::Record
134 sub delete { die "Log entries can't be modified." };
136 sub replace { die "Log entries can't be modified." };
140 Checks all fields to make sure this is a valid example. If there is
141 an error, returns the error, otherwise returns false. Called by the insert
150 $self->ut_numbern('lognum')
151 || $self->ut_number('_date')
152 || $self->ut_numbern('agentnum')
153 || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
154 || $self->ut_textn('tablename')
155 || $self->ut_numbern('tablenum')
156 || $self->ut_number('level')
157 || $self->ut_anything('message')
159 return $error if $error;
161 if ( my $tablename = $self->tablename ) {
162 my $dbdef_table = dbdef->table($tablename)
163 or return "tablename '$tablename' does not exist";
164 $error = $self->ut_foreign_key('tablenum',
166 $dbdef_table->primary_key);
167 return $error if $error;
175 Returns the context for this log entry, as an array, from least to most
182 map { $_->context } qsearch({
183 table => 'log_context',
184 hashref => { lognum => $self->lognum },
185 order_by => 'ORDER BY logcontextnum ASC',
197 Returns a qsearch hash expression to search for parameters specified in
198 HASHREF. Valid parameters are:
204 =item date - arrayref of start and end date
206 =item level - either a specific level, or an arrayref of min and max level
208 =item context - a context string that the log entry must have. This may
209 change in the future to allow searching for combinations of context strings.
211 =item object - any database object, to find log entries related to it.
213 =item tablename, tablenum - alternate way of specifying 'object'.
215 =item custnum - a customer number, to find log entries related to the customer
216 or any of their subordinate objects (invoices, packages, etc.).
218 =item message - a text string to search in messages. The search will be
219 a case-insensitive LIKE with % appended at both ends.
225 # used for custnum search: all tables with custnums
228 sub _setup_table_stubs {
254 my $pkey = dbdef->table($table)->primary_key;
256 "log.tablename = '$table' AND ".
257 "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ".
258 "$table.custnum = "; # needs a closing )
262 "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ".
263 "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ".
264 "cust_pkg.custnum = "; # needs a closing )
268 my ($class, $params) = @_;
275 if ( $params->{'agentnum'} =~ /^(\d+)$/ ) {
284 if ( $params->{'custnum'} =~ /^(\d+)$/ ) {
285 _setup_table_stubs() unless @table_stubs;
287 my @orwhere = map { "( $_ $custnum) )" } @table_stubs;
288 push @where, join(' OR ', @orwhere);
295 if ( ref $params->{'level'} eq 'ARRAY' ) {
296 my ($min, $max) = @{ $params->{'level'} };
297 if ( $min =~ /^\d+$/ ) {
298 push @where, "log.level >= $min";
300 if ( $max =~ /^\d+$/ ) {
301 push @where, "log.level <= $max";
303 } elsif ( $params->{'level'} =~ /^(\d+)$/ ) {
304 push @where, "log.level = $1";
311 if ( ref $params->{'date'} eq 'ARRAY' ) {
312 my ($beg, $end) = @{ $params->{'date'} };
313 if ( $beg =~ /^\d+$/ ) {
314 push @where, "log._date >= $beg";
316 if ( $end =~ /^\d+$/ ) {
317 push @where, "log._date <= $end";
325 if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) {
326 my $table = $params->{'object'}->table;
327 my $pkey = dbdef->table($table)->primary_key;
328 my $tablenum = $params->{'object'}->get($pkey);
329 if ( $table and $tablenum ) {
330 push @where, "log.tablename = '$table'", "log.tablenum = $tablenum";
332 } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) {
334 if ( $params->{'tablenum'} =~ /^(\d+)$/ ) {
335 push @where, "log.tablename = '$table'", "log.tablenum = $1";
343 if ( $params->{'message'} ) { # can be anything, really, so escape it
344 my $quoted_message = dbh->quote('%' . $params->{'message'} . '%');
345 my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE');
346 push @where, "log.message $op $quoted_message";
353 if ( $params->{'context'} ) {
354 my $quoted = dbh->quote($params->{'context'});
355 if ( $params->{'context_height'} =~ /^\d+$/ ) {
356 my $subq = 'SELECT context FROM log_context WHERE log.lognum = log_context.lognum'.
357 ' ORDER BY logcontextnum DESC LIMIT '.$params->{'context_height'};
359 "EXISTS(SELECT 1 FROM ($subq) AS log_context_x WHERE log_context_x.context = $quoted)";
362 "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
363 "AND log_context.context = $quoted)";
367 # agent virtualization
368 my $access_user = $FS::CurrentUser::CurrentUser;
369 push @where, $access_user->agentnums_sql(
371 viewall_right => 'Configuration',
377 $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where;
378 my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql;
383 'extra_sql' => $extra_sql,
384 'count_query' => $count_query,
385 'order_by' => 'ORDER BY _date ASC',
386 #addl_from, not needed
391 my ($class, %opts) = @_;
393 return if FS::upgrade_journal->is_done('log__remap_levels');
395 tie my %levelmap, 'Tie::IxHash',
396 2 => 1, #notice -> info
397 6 => 5, #alert -> critical
398 7 => 5, #emergency -> critical
401 # this method should never autocommit
402 # should have been set in upgrade, but just in case...
403 local $FS::UID::AutoCommit = 0;
405 # in practice, only debug/info/warning/error appear to have been used,
406 # so this probably won't do anything, but just in case
407 foreach my $old (keys %levelmap) {
408 # FS::log has no replace method
409 my $sql = 'UPDATE log SET level=' . dbh->quote($levelmap{$old}) . ' WHERE level=' . dbh->quote($old);
410 warn $sql unless $opts{'quiet'};
411 my $sth = dbh->prepare($sql) or die dbh->errstr;
412 $sth->execute() or die $sth->errstr;
416 foreach my $log_email (
417 qsearch('log_email',{ 'min_level' => 2 }),
418 qsearch('log_email',{ 'min_level' => 6 }),
419 qsearch('log_email',{ 'min_level' => 7 }),
421 $log_email->min_level($levelmap{$log_email->min_level});
422 my $error = $log_email->replace;
429 FS::upgrade_journal->set_done('log__remap_levels');
439 L<FS::Record>, schema.html from the base documentation.