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 $prospect_contact = ($self->prospect_contact)[0]; #first contact?  good enough for now
 274   my $contact = $prospect_contact->contact if $prospect_contact;
 275   return $contact->line if $prospect_contact && $contact;
 276
 277   #address?
 278
 279   'Prospect #'. $self->prospectnum;
 280 }
 281
 282 =item contact_firstlast
 283
 284 If this prospect has a company, returns the empty string.  If not, returns the
 285 first contact's first and last name.
 286
 287 Primarily intended for use in quotation substitutions, like the FS::cust_main
 288 method of the same name.
 289
 290 =cut
 291
 292 sub contact_firstlast {
 293   my $self = shift;
 294   return '' if $self->company;
 295   my @contacts = $self->contact;
 296   #return '' unless @contacts;
 297   warn $contacts[0]->first;
 298   warn $contacts[0]->get('last');
 299   $contacts[0]->first. ' '. $contacts[0]->get('last');
 300 }
 301
 302 =item contact
 303
 304 Returns the contacts (see L<FS::contact>) associated with this prospect.
 305
 306 =cut
 307
 308 sub contact {
 309   my $self = shift;
 310   my $search = {
 311     table       => 'contact',
 312     addl_from   => ' JOIN prospect_contact USING (contactnum)',
 313     extra_sql   => ' WHERE prospect_contact.prospectnum = '.$self->prospectnum,
 314   };
 315
 316   #classnum argument like FS::cust_main->contact?
 317
 318   qsearch($search);
 319 }
 320
 321 =item cust_location
 322
 323 Returns the locations (see L<FS::cust_location>) associated with this prospect.
 324
 325 =cut
 326
 327 sub cust_location {
 328   my $self = shift;
 329   qsearch({
 330     'table'   => 'cust_location',
 331     'hashref' => { 'prospectnum' => $self->prospectnum,
 332                    'custnum'     => '',
 333                  },
 334     'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
 335   });
 336 }
 337
 338 =item qual
 339
 340 Returns the qualifications (see L<FS::qual>) associated with this prospect.
 341
 342 =item agent
 343
 344 Returns the agent (see L<FS::agent>) for this customer.
 345
 346 =item tax_status
 347
 348 Returns the external tax status, as an FS::tax_status object, or the empty
 349 string if there is no tax status.
 350
 351 =cut
 352
 353 sub tax_status {
 354   my $self = shift;
 355   if ( $self->taxstatusnum ) {
 356     qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
 357   } else {
 358     return '';
 359   }
 360 }
 361
 362 =item taxstatus
 363
 364 Returns the tax status code if there is one.
 365
 366 =cut
 367
 368 sub taxstatus {
 369   my $self = shift;
 370   my $tax_status = $self->tax_status;
 371   $tax_status
 372     ? $tax_status->taxstatus
 373     : '';
 374 }
 375
 376 =item convert_cust_main
 377
 378 Converts this prospect to a customer.
 379
 380 If there is an error, returns an error message, otherwise, returns the
 381 newly-created FS::cust_main object.
 382
 383 =cut
 384
 385 sub convert_cust_main {
 386   my $self = shift;
 387
 388   my @cust_location = $self->cust_location;
 389   #the interface only allows one, so we're just gonna go with that for now
 390
 391   my @contact = map $_->contact, $self->prospect_contact;
 392
 393   #XXX i'm not compatible with cust_main-require_phone (which is kind of a
 394   # pre-contact thing anyway)
 395
 396   my $cust_main = new FS::cust_main {
 397     'bill_location' => $cust_location[0],
 398     'ship_location' => $cust_location[0],
 399     ( map { $_ => $self->$_ } qw( agentnum refnum company taxstatusnum ) ),
 400   };
 401
 402   $cust_main->refnum( FS::Conf->new->config('referraldefault') || 1  )
 403     unless $cust_main->refnum;
 404
 405   #XXX again, arbitrary, if one contact was "billing", that would be better
 406   if ( $contact[0] ) {
 407     $cust_main->set($_, $contact[0]->get($_)) foreach qw( first last );
 408   } else {
 409     $cust_main->set('first', 'Unknown');
 410     $cust_main->set('last',  'Unknown');
 411   }
 412
 413   #v3 payby no longer allowed
 414   #$cust_main->payby('BILL');
 415   #$cust_main->paydate('12/2037');
 416
 417   $cust_main->insert( {},
 418     'prospectnum' => $self->prospectnum,
 419   )
 420     or $cust_main;
 421 }
 422
 423 =item search HASHREF
 424
 425 (Class method)
 426
 427 Returns a qsearch hash expression to search for the parameters specified in
 428 HASHREF.  Valid parameters are:
 429
 430 =over 4
 431
 432 =item agentnum
 433
 434 =back
 435
 436 =cut
 437
 438 sub search {
 439   my( $class, $params ) = @_;
 440
 441   my @where = ();
 442   my $orderby;
 443
 444   #agent
 445   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
 446     push @where,
 447       "prospect_main.agentnum = $1";
 448   }
 449
 450   #refnum
 451   if ( $params->{'refnum'} =~ /^(\d+)$/ and $1 ) {
 452     push @where,
 453       "prospect_main.refnum = $1";
 454   }
 455
 456   ##
 457   # setup queries, subs, etc. for the search
 458   ##
 459
 460   $orderby ||= 'ORDER BY prospectnum';
 461
 462   # here is the agent virtualization
 463   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
 464
 465   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
 466
 467   my $count_query = "SELECT COUNT(*) FROM prospect_main $extra_sql";
 468
 469   my $sql_query = {
 470     'table'         => 'prospect_main',
 471     #'select'        => $select,
 472     'hashref'       => {},
 473     'extra_sql'     => $extra_sql,
 474     'order_by'      => $orderby,
 475     'count_query'   => $count_query,
 476     #'extra_headers' => \@extra_headers,
 477     #'extra_fields'  => \@extra_fields,
 478   };
 479
 480 }
 481
 482 # stub this so that calling ->cust_bill doesn't return an empty string
 483 sub cust_bill {
 484   return;
 485 }
 486
 487 # XXX should have real localization here eventually
 488 sub locale {
 489   FS::Conf->new->config('locale');
 490 }
 491
 492 =back
 493
 494 =head1 BUGS
 495
 496 =head1 SEE ALSO
 497
 498 L<FS::Record>, schema.html from the base documentation.
 499
 500 =cut
 501
 502 1;
 503