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