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