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