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