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