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