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