optimize customer list, RT#20173
[freeside.git] / FS / FS / prospect_main.pm
1 package FS::prospect_main;
2 use base qw( FS::Quotable_Mixin FS::o2m_Common FS::Record );
3
4 use strict;
5 use vars qw( $DEBUG @location_fields );
6 use Scalar::Util qw( blessed );
7 use FS::Conf;
8 use FS::Record qw( dbh qsearch qsearchs );
9 use FS::cust_location;
10 use FS::cust_main;
11
12 $DEBUG = 0;
13
14 #started as false laziness w/cust_main/Location.pm
15
16 use Carp qw(carp);
17
18 my $init = 0;
19 BEGIN {
20   # set up accessors for location fields
21   if (!$init) {
22     no strict 'refs';
23     @location_fields = 
24       qw( address1 address2 city county state zip country district
25         latitude longitude coord_auto censustract censusyear geocode
26         addr_clean );
27
28     foreach my $f (@location_fields) {
29       *{"FS::prospect_main::$f"} = sub {
30         carp "WARNING: tried to set cust_main.$f with accessor" if (@_ > 1);
31         my @cust_location = shift->cust_location or return '';
32         #arbitrarily picking the first because the UI only lets you add one
33         $cust_location[0]->$f
34       };
35     }
36     $init++;
37   }
38 }
39
40 #debugging shim--probably a performance hit, so remove this at some point
41 sub get {
42   my $self = shift;
43   my $field = shift;
44   if ( $DEBUG and grep { $_ eq $field } @location_fields ) {
45     carp "WARNING: tried to get() location field $field";
46     $self->$field;
47   }
48   $self->FS::Record::get($field);
49 }
50
51 =head1 NAME
52
53 FS::prospect_main - Object methods for prospect_main records
54
55 =head1 SYNOPSIS
56
57   use FS::prospect_main;
58
59   $record = new FS::prospect_main \%hash;
60   $record = new FS::prospect_main { 'column' => 'value' };
61
62   $error = $record->insert;
63
64   $error = $new_record->replace($old_record);
65
66   $error = $record->delete;
67
68   $error = $record->check;
69
70 =head1 DESCRIPTION
71
72 An FS::prospect_main object represents a prospect.  FS::prospect_main inherits
73 from FS::Record.  The following fields are currently supported:
74
75 =over 4
76
77 =item prospectnum
78
79 primary key
80
81 =item agentnum
82
83 Agent (see L<FS::agent>)
84
85 =item refnum
86
87 Referral (see L<FS::part_referral>)
88
89 =item company
90
91 company
92
93 =back
94
95 =head1 METHODS
96
97 =over 4
98
99 =item new HASHREF
100
101 Creates a new prospect.  To add the prospect to the database, see L<"insert">.
102
103 Note that this stores the hash reference, not a distinct copy of the hash it
104 points to.  You can ask the object for a copy with the I<hash> method.
105
106 =cut
107
108 sub table { 'prospect_main'; }
109
110 =item insert
111
112 Adds this record to the database.  If there is an error, returns the error,
113 otherwise returns false.
114
115 =cut
116
117 sub insert {
118   my $self = shift;
119   my %options = @_;
120   warn "FS::prospect_main::insert called on $self with options ".
121        join(', ', map "$_=>$options{$_}", keys %options)
122     if $DEBUG;
123
124   local $SIG{HUP} = 'IGNORE';
125   local $SIG{INT} = 'IGNORE';
126   local $SIG{QUIT} = 'IGNORE';
127   local $SIG{TERM} = 'IGNORE';
128   local $SIG{TSTP} = 'IGNORE';
129   local $SIG{PIPE} = 'IGNORE';
130
131   my $oldAutoCommit = $FS::UID::AutoCommit;
132   local $FS::UID::AutoCommit = 0;
133   my $dbh = dbh;
134
135   warn "  inserting prospect_main record" if $DEBUG;
136   my $error = $self->SUPER::insert;
137   if ( $error ) {
138     $dbh->rollback if $oldAutoCommit;
139     return $error;
140   }
141
142   if ( $options{'cust_location'} ) {
143     warn "  inserting cust_location record" if $DEBUG;
144     my $cust_location = $options{'cust_location'};
145     $cust_location->prospectnum($self->prospectnum);
146     $error = $cust_location->insert;
147     if ( $error ) {
148       $dbh->rollback if $oldAutoCommit;
149       return $error;
150     }
151   }
152
153   warn "  commiting transaction" if $DEBUG;
154   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
155
156   '';
157 }
158
159 =item delete
160
161 Delete this record from the database.
162
163 =cut
164
165 #delete dangling locations?
166
167 =item replace OLD_RECORD
168
169 Replaces the OLD_RECORD with this one in the database.  If there is an error,
170 returns the error, otherwise returns false.
171
172 =cut
173
174 sub replace {
175   my $new = shift;
176
177   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
178               ? shift
179               : $new->replace_old;
180
181   my %options = @_;
182
183   warn "FS::prospect_main::replace called on $new to replace $old with options".
184        " ". join(', ', map "$_ => ". $options{$_}, keys %options)
185     if $DEBUG;
186
187   local $SIG{HUP} = 'IGNORE';
188   local $SIG{INT} = 'IGNORE';
189   local $SIG{QUIT} = 'IGNORE';
190   local $SIG{TERM} = 'IGNORE';
191   local $SIG{TSTP} = 'IGNORE';
192   local $SIG{PIPE} = 'IGNORE';
193
194   my $oldAutoCommit = $FS::UID::AutoCommit;
195   local $FS::UID::AutoCommit = 0;
196   my $dbh = dbh;
197
198   warn "  replacing prospect_main record" if $DEBUG;
199   my $error = $new->SUPER::replace($old);
200   if ( $error ) {
201     $dbh->rollback if $oldAutoCommit;
202     return $error;
203   }
204
205   if ( $options{'cust_location'} ) {
206     my $cust_location = $options{'cust_location'};
207     $cust_location->prospectnum($new->prospectnum);
208     my $method = $cust_location->locationnum ? 'replace' : 'insert';
209     warn "  ${method}ing cust_location record" if $DEBUG;
210     $error = $cust_location->$method();
211     if ( $error ) {
212       $dbh->rollback if $oldAutoCommit;
213       return $error;
214     }
215   } elsif ( exists($options{'cust_location'}) ) {
216     foreach my $cust_location (
217       qsearch('cust_location', { 'prospectnum' => $new->prospectnum } )
218     ) {
219       $error = $cust_location->delete();
220       if ( $error ) {
221         $dbh->rollback if $oldAutoCommit;
222         return $error;
223       }
224     }
225   }
226
227   warn "  commiting transaction" if $DEBUG;
228   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
229
230   '';
231 }
232
233 =item check
234
235 Checks all fields to make sure this is a valid prospect.  If there is
236 an error, returns the error, otherwise returns false.  Called by the insert
237 and replace methods.
238
239 =cut
240
241 sub check {
242   my $self = shift;
243
244   my $error = 
245     $self->ut_numbern('prospectnum')
246     || $self->ut_foreign_key(  'agentnum', 'agent',         'agentnum' )
247     || $self->ut_foreign_keyn( 'refnum',   'part_referral', 'refnum'   )
248     || $self->ut_textn('company')
249     || $self->ut_foreign_keyn( 'taxstatusnum', 'tax_status', 'taxstatusnum' )
250   ;
251   return $error if $error;
252
253   my $company = $self->company;
254   $company =~ s/^\s+//; 
255   $company =~ s/\s+$//; 
256   $company =~ s/\s+/ /g;
257   $self->company($company);
258
259   $self->SUPER::check;
260 }
261
262 =item name
263
264 Returns a name for this prospect, as a string (company name for commercial
265 prospects, contact name for residential prospects).
266
267 =cut
268
269 sub name {
270   my $self = shift;
271   return $self->company if $self->company;
272
273   my $contact = ($self->prospect_contact)[0]->contact; #first contact?  good enough for now
274   return $contact->line if $contact;
275
276   'Prospect #'. $self->prospectnum;
277 }
278
279 =item contact
280
281 Returns the contacts (see L<FS::contact>) associated with this prospect.
282
283 =item cust_location
284
285 Returns the locations (see L<FS::cust_location>) associated with this prospect.
286
287 =cut
288
289 sub cust_location {
290   my $self = shift;
291   qsearch({
292     'table'   => 'cust_location',
293     'hashref' => { 'prospectnum' => $self->prospectnum,
294                    'custnum'     => '',
295                  },
296     'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
297   });
298 }
299
300 =item qual
301
302 Returns the qualifications (see L<FS::qual>) associated with this prospect.
303
304 =item agent
305
306 Returns the agent (see L<FS::agent>) for this customer.
307
308 =item tax_status
309
310 Returns the external tax status, as an FS::tax_status object, or the empty 
311 string if there is no tax status.
312
313 =cut
314
315 sub tax_status {
316   my $self = shift;
317   if ( $self->taxstatusnum ) {
318     qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
319   } else { 
320     return '';
321   }
322 }
323
324 =item taxstatus
325
326 Returns the tax status code if there is one.
327
328 =cut
329
330 sub taxstatus {
331   my $self = shift;
332   my $tax_status = $self->tax_status;
333   $tax_status
334     ? $tax_status->taxstatus
335     : '';
336 }
337
338 =item convert_cust_main
339
340 Converts this prospect to a customer.
341
342 If there is an error, returns an error message, otherwise, returns the
343 newly-created FS::cust_main object.
344
345 =cut
346
347 sub convert_cust_main {
348   my $self = shift;
349
350   my @cust_location = $self->cust_location;
351   #the interface only allows one, so we're just gonna go with that for now
352
353   my @contact = map $_->contact, $self->prospect_contact;
354
355   #XXX define one contact type as "billing", then we could pick just that one
356   my @invoicing_list = map $_->emailaddress, map $_->contact_email, @contact;
357
358   #XXX i'm not compatible with cust_main-require_phone (which is kind of a
359   # pre-contact thing anyway)
360
361   my $cust_main = new FS::cust_main {
362     'bill_location' => $cust_location[0],
363     'ship_location' => $cust_location[0],
364     ( map { $_ => $self->$_ } qw( agentnum refnum company taxstatusnum ) ),
365   };
366
367   $cust_main->refnum( FS::Conf->new->config('referraldefault') || 1  )
368     unless $cust_main->refnum;
369
370   #XXX again, arbitrary, if one contact was "billing", that would be better
371   if ( $contact[0] ) {
372     $cust_main->set($_, $contact[0]->get($_)) foreach qw( first last );
373   } else {
374     $cust_main->set('first', 'Unknown');
375     $cust_main->set('last',  'Unknown');
376   }
377
378   #v3 payby no longer allowed
379   #$cust_main->payby('BILL');
380   #$cust_main->paydate('12/2037');
381
382   $cust_main->insert( {}, \@invoicing_list,
383     'prospectnum' => $self->prospectnum,
384   )
385     or $cust_main;
386 }
387
388 =item search HASHREF
389
390 (Class method)
391
392 Returns a qsearch hash expression to search for the parameters specified in
393 HASHREF.  Valid parameters are:
394
395 =over 4
396
397 =item agentnum
398
399 =back
400
401 =cut
402
403 sub search {
404   my( $class, $params ) = @_;
405
406   my @where = ();
407   my $orderby;
408
409   ##
410   # parse agent
411   ##
412
413   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
414     push @where,
415       "prospect_main.agentnum = $1";
416   }
417
418   ##
419   # setup queries, subs, etc. for the search
420   ##
421
422   $orderby ||= 'ORDER BY prospectnum';
423
424   # here is the agent virtualization
425   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
426
427   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
428
429   my $count_query = "SELECT COUNT(*) FROM prospect_main $extra_sql";
430   
431   my $sql_query = {
432     'table'         => 'prospect_main',
433     #'select'        => $select,
434     'hashref'       => {},
435     'extra_sql'     => $extra_sql,
436     'order_by'      => $orderby,
437     'count_query'   => $count_query,
438     #'extra_headers' => \@extra_headers,
439     #'extra_fields'  => \@extra_fields,
440   };
441
442 }
443
444 # stub this so that calling ->cust_bill doesn't return an empty string
445 sub cust_bill {
446   return;
447 }
448
449 # XXX should have real localization here eventually
450 sub locale {
451   FS::Conf->new->config('locale');
452 }
453
454 =back
455
456 =head1 BUGS
457
458 =head1 SEE ALSO
459
460 L<FS::Record>, schema.html from the base documentation.
461
462 =cut
463
464 1;
465