FS/FS/log.pm

   1 package FS::log;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use FS::Record qw( qsearch qsearchs dbdef );
   6 use FS::UID qw( dbh driver_name );
   7 use FS::log_context;
   8 use FS::log_email;
   9
  10 =head1 NAME
  11
  12 FS::log - Object methods for log records
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::log;
  17
  18   $record = new FS::log \%hash;
  19   $record = new FS::log { 'column' => 'value' };
  20
  21   $error = $record->insert;
  22
  23   $error = $new_record->replace($old_record);
  24
  25   $error = $record->delete;
  26
  27   $error = $record->check;
  28
  29 =head1 DESCRIPTION
  30
  31 An FS::log object represents a log entry.  FS::log inherits from
  32 FS::Record.  The following fields are currently supported:
  33
  34 =over 4
  35
  36 =item lognum - primary key
  37
  38 =item _date - Unix timestamp
  39
  40 =item agentnum - L<FS::agent> to which the log pertains.  If it involves a
  41 specific customer, package, service, invoice, or other agent-specific object,
  42 this will be set to that agentnum.
  43
  44 =item tablename - table name to which the log pertains, if any.
  45
  46 =item tablenum - foreign key to that table.
  47
  48 =item level - log level: 'debug', 'info', 'notice', 'warning', 'error',
  49 'critical', 'alert', 'emergency'.
  50
  51 =item message - contents of the log entry
  52
  53 =back
  54
  55 =head1 METHODS
  56
  57 =over 4
  58
  59 =item new HASHREF
  60
  61 Creates a new log entry.  Use FS::Log instead of calling this directly,
  62 please.
  63
  64 =cut
  65
  66 sub table { 'log'; }
  67
  68 =item insert [ CONTEXT... ]
  69
  70 Adds this record to the database.  If there is an error, returns the error,
  71 otherwise returns false.
  72
  73 CONTEXT may be a list of context tags to attach to this record.
  74
  75 Will send emails according to the conditions in L<FS::log_email>.
  76
  77 =cut
  78
  79 sub insert {
  80   # not using process_o2m for this, because we don't have a web interface
  81   my $self = shift;
  82   my $error = $self->SUPER::insert;
  83   return $error if $error;
  84   my $contexts = {};       # for quick checks when sending emails
  85   my $context_height = @_; # also for email check
  86   foreach ( @_ ) { # ordered from least to most specific
  87     my $context = FS::log_context->new({
  88         'lognum'  => $self->lognum,
  89         'context' => $_
  90     });
  91     $error = $context->insert;
  92     return $error if $error;
  93     $contexts->{$_} = $context_height--;
  94   }
  95   foreach my $log_email (
  96     qsearch('log_email',
  97       {
  98         'disabled' => '',
  99         'min_level' => {
 100           'op' => '<=',
 101           'value' => $self->level,
 102         },
 103       }
 104     )
 105   ) {
 106     # shouldn't be a lot of log_email records, so not packing these checks into the qsearch
 107     next if $log_email->context && !$contexts->{$log_email->context};
 108     next if $log_email->context_height && ($contexts->{$log_email->context} > $log_email->context_height);
 109     my $msg_template = qsearchs('msg_template',{ 'msgnum' => $log_email->msgnum });
 110     unless ($msg_template) {
 111       warn "Could not send email when logging, could not load message template for logemailnum " . $log_email->logemailnum;
 112       next;
 113     }
 114     my $emailerror = $msg_template->send(
 115       'msgtype'       => 'admin',
 116       'to'            => $log_email->to_addr,
 117       'substitutions' => {
 118         'loglevel'   => $FS::Log::LEVELS[$self->level], # which has hopefully been loaded...
 119         'logcontext' => $log_email->context, # use the one that triggered the email
 120         'logmessage' => $self->message,
 121       },
 122     );
 123     warn "Could not send email when logging: $emailerror" if $emailerror;
 124   }
 125   '';
 126 }
 127
 128 # these methods can be inherited from FS::Record
 129
 130 sub delete  { die "Log entries can't be modified." };
 131
 132 sub replace { die "Log entries can't be modified." };
 133
 134 =item check
 135
 136 Checks all fields to make sure this is a valid example.  If there is
 137 an error, returns the error, otherwise returns false.  Called by the insert
 138 and replace methods.
 139
 140 =cut
 141
 142 sub check {
 143   my $self = shift;
 144
 145   my $error =
 146     $self->ut_numbern('lognum')
 147     || $self->ut_number('_date')
 148     || $self->ut_numbern('agentnum')
 149     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 150     || $self->ut_textn('tablename')
 151     || $self->ut_numbern('tablenum')
 152     || $self->ut_number('level')
 153     || $self->ut_anything('message')
 154   ;
 155   return $error if $error;
 156
 157   if ( my $tablename = $self->tablename ) {
 158     my $dbdef_table = dbdef->table($tablename)
 159       or return "tablename '$tablename' does not exist";
 160     $error = $self->ut_foreign_key('tablenum',
 161                                    $tablename,
 162                                    $dbdef_table->primary_key);
 163     return $error if $error;
 164   }
 165
 166   $self->SUPER::check;
 167 }
 168
 169 =item context
 170
 171 Returns the context for this log entry, as an array, from least to most
 172 specific.
 173
 174 =cut
 175
 176 sub context {
 177   my $self = shift;
 178   map { $_->context } qsearch({
 179       table     => 'log_context',
 180       hashref   => { lognum => $self->lognum },
 181       order_by  => 'ORDER BY logcontextnum ASC',
 182   });
 183 }
 184
 185 =back
 186
 187 =head1 CLASS METHODS
 188
 189 =over 4
 190
 191 =item search HASHREF
 192
 193 Returns a qsearch hash expression to search for parameters specified in
 194 HASHREF.  Valid parameters are:
 195
 196 =over 4
 197
 198 =item agentnum
 199
 200 =item date - arrayref of start and end date
 201
 202 =item level - either a specific level, or an arrayref of min and max level
 203
 204 =item context - a context string that the log entry must have.  This may
 205 change in the future to allow searching for combinations of context strings.
 206
 207 =item object - any database object, to find log entries related to it.
 208
 209 =item tablename, tablenum - alternate way of specifying 'object'.
 210
 211 =item custnum - a customer number, to find log entries related to the customer
 212 or any of their subordinate objects (invoices, packages, etc.).
 213
 214 =item message - a text string to search in messages.  The search will be
 215 a case-insensitive LIKE with % appended at both ends.
 216
 217 =back
 218
 219 =cut
 220
 221 # used for custnum search: all tables with custnums
 222 my @table_stubs;
 223
 224 sub _setup_table_stubs {
 225   foreach my $table (
 226     qw(
 227     contact
 228     cust_attachment
 229     cust_bill
 230     cust_credit
 231     cust_location
 232     cust_main
 233     cust_main_exemption
 234     cust_main_note
 235     cust_msg
 236     cust_pay
 237     cust_pay_batch
 238     cust_pay_pending
 239     cust_pay_void
 240     cust_pkg
 241     cust_refund
 242     cust_statement
 243     cust_tag
 244     cust_tax_adjustment
 245     cust_tax_exempt
 246     did_order_item
 247     qual
 248     queue ) )
 249   {
 250     my $pkey = dbdef->table($table)->primary_key;
 251     push @table_stubs,
 252       "log.tablename = '$table' AND ".
 253       "EXISTS(SELECT 1 FROM $table WHERE log.tablenum = $table.$pkey AND ".
 254       "$table.custnum = "; # needs a closing )
 255   }
 256   # plus this case
 257   push @table_stubs,
 258       "(log.tablename LIKE 'svc_%' OR log.tablename = 'cust_svc') AND ".
 259       "EXISTS(SELECT 1 FROM cust_svc JOIN cust_pkg USING (svcnum) WHERE ".
 260       "cust_pkg.custnum = "; # needs a closing )
 261 }
 262
 263 sub search {
 264   my ($class, $params) = @_;
 265   my @where;
 266
 267   ##
 268   # parse agent
 269   ##
 270
 271   if ( $params->{'agentnum'} =~ /^(\d+)$/ ) {
 272     push @where,
 273       "log.agentnum = $1";
 274   }
 275
 276   ##
 277   # parse custnum
 278   ##
 279
 280   if ( $params->{'custnum'} =~ /^(\d+)$/ ) {
 281     _setup_table_stubs() unless @table_stubs;
 282     my $custnum = $1;
 283     my @orwhere = map { "( $_ $custnum) )" } @table_stubs;
 284     push @where, join(' OR ', @orwhere);
 285   }
 286
 287   ##
 288   # parse level
 289   ##
 290
 291   if ( ref $params->{'level'} eq 'ARRAY' ) {
 292     my ($min, $max) = @{ $params->{'level'} };
 293     if ( $min =~ /^\d+$/ ) {
 294       push @where, "log.level >= $min";
 295     }
 296     if ( $max =~ /^\d+$/ ) {
 297       push @where, "log.level <= $max";
 298     }
 299   } elsif ( $params->{'level'} =~ /^(\d+)$/ ) {
 300     push @where, "log.level = $1";
 301   }
 302
 303   ##
 304   # parse date
 305   ##
 306
 307   if ( ref $params->{'date'} eq 'ARRAY' ) {
 308     my ($beg, $end) = @{ $params->{'date'} };
 309     if ( $beg =~ /^\d+$/ ) {
 310       push @where, "log._date >= $beg";
 311     }
 312     if ( $end =~ /^\d+$/ ) {
 313       push @where, "log._date <= $end";
 314     }
 315   }
 316
 317   ##
 318   # parse object
 319   ##
 320
 321   if ( $params->{'object'} and $params->{'object'}->isa('FS::Record') ) {
 322     my $table = $params->{'object'}->table;
 323     my $pkey = dbdef->table($table)->primary_key;
 324     my $tablenum = $params->{'object'}->get($pkey);
 325     if ( $table and $tablenum ) {
 326       push @where, "log.tablename = '$table'", "log.tablenum = $tablenum";
 327     }
 328   } elsif ( $params->{'tablename'} =~ /^(\w+)$/ ) {
 329     my $table = $1;
 330     if ( $params->{'tablenum'} =~ /^(\d+)$/ ) {
 331       push @where, "log.tablename = '$table'", "log.tablenum = $1";
 332     }
 333   }
 334
 335   ##
 336   # parse message
 337   ##
 338
 339   if ( $params->{'message'} ) { # can be anything, really, so escape it
 340     my $quoted_message = dbh->quote('%' . $params->{'message'} . '%');
 341     my $op = (driver_name eq 'Pg' ? 'ILIKE' : 'LIKE');
 342     push @where, "log.message $op $quoted_message";
 343   }
 344
 345   ##
 346   # parse context
 347   ##
 348
 349   if ( $params->{'context'} ) {
 350     my $quoted = dbh->quote($params->{'context'});
 351     if ( $params->{'context_height'} =~ /^\d+$/ ) {
 352       my $subq = 'SELECT context FROM log_context WHERE log.lognum = log_context.lognum'.
 353                  ' ORDER BY logcontextnum DESC LIMIT '.$params->{'context_height'};
 354       push @where,
 355         "EXISTS(SELECT 1 FROM ($subq) AS log_context_x WHERE log_context_x.context = $quoted)";
 356     } else {
 357       push @where,
 358         "EXISTS(SELECT 1 FROM log_context WHERE log.lognum = log_context.lognum ".
 359         "AND log_context.context = $quoted)";
 360     }
 361   }
 362
 363   # agent virtualization
 364   my $access_user = $FS::CurrentUser::CurrentUser;
 365   push @where, $access_user->agentnums_sql(
 366     table => 'log',
 367     viewall_right => 'Configuration',
 368     null => 1,
 369   );
 370
 371   # put it together
 372   my $extra_sql = '';
 373   $extra_sql .= 'WHERE ' . join(' AND ', @where) if @where;
 374   my $count_query = 'SELECT COUNT(*) FROM log '.$extra_sql;
 375   my $sql_query = {
 376     'table'         => 'log',
 377     'hashref'       => {},
 378     'select'        => 'log.*',
 379     'extra_sql'     => $extra_sql,
 380     'count_query'   => $count_query,
 381     'order_by'      => 'ORDER BY _date ASC',
 382     #addl_from, not needed
 383   };
 384 }
 385
 386 =back
 387
 388 =head1 BUGS
 389
 390 =head1 SEE ALSO
 391
 392 L<FS::Record>, schema.html from the base documentation.
 393
 394 =cut
 395
 396 1;
 397