FS/FS/contact.pm

   1 package FS::contact;
   2 use base qw( FS::Password_Mixin
   3              FS::Record );
   4
   5 use strict;
   6 use vars qw( $skip_fuzzyfiles );
   7 use Carp;
   8 use Scalar::Util qw( blessed );
   9 use FS::Record qw( qsearch qsearchs dbh );
  10 use FS::Cursor;
  11 use FS::contact_phone;
  12 use FS::contact_email;
  13 use FS::contact::Import;
  14 use FS::queue;
  15 use FS::phone_type; #for cgi_contact_fields
  16 use FS::cust_contact;
  17 use FS::prospect_contact;
  18
  19 $skip_fuzzyfiles = 0;
  20
  21 =head1 NAME
  22
  23 FS::contact - Object methods for contact records
  24
  25 =head1 SYNOPSIS
  26
  27   use FS::contact;
  28
  29   $record = new FS::contact \%hash;
  30   $record = new FS::contact { 'column' => 'value' };
  31
  32   $error = $record->insert;
  33
  34   $error = $new_record->replace($old_record);
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::contact object represents an specific contact person for a prospect or
  43 customer.  FS::contact inherits from FS::Record.  The following fields are
  44 currently supported:
  45
  46 =over 4
  47
  48 =item contactnum
  49
  50 primary key
  51
  52 =item prospectnum
  53
  54 prospectnum
  55
  56 =item custnum
  57
  58 custnum
  59
  60 =item locationnum
  61
  62 locationnum
  63
  64 =item last
  65
  66 last
  67
  68 =item first
  69
  70 first
  71
  72 =item title
  73
  74 title
  75
  76 =item comment
  77
  78 comment
  79
  80 =item selfservice_access
  81
  82 empty or Y
  83
  84 =item _password
  85
  86 =item _password_encoding
  87
  88 empty or bcrypt
  89
  90 =item disabled
  91
  92 disabled
  93
  94 =back
  95
  96 =head1 METHODS
  97
  98 =over 4
  99
 100 =item new HASHREF
 101
 102 Creates a new contact.  To add the contact to the database, see L<"insert">.
 103
 104 Note that this stores the hash reference, not a distinct copy of the hash it
 105 points to.  You can ask the object for a copy with the I<hash> method.
 106
 107 =cut
 108
 109 sub table { 'contact'; }
 110
 111 =item insert
 112
 113 Adds this record to the database.  If there is an error, returns the error,
 114 otherwise returns false.
 115
 116 If the object has an C<emailaddress> field, L<FS::contact_email> records
 117 will be created for each (comma-separated) email address in that field. If
 118 any of these coincide with an existing email address, this contact will be
 119 merged with the contact with that address.
 120
 121 Then, if the object has any fields named C<phonetypenumN> an
 122 L<FS::contact_phone> record will be created for each of them. Those fields
 123 should contain phone numbers of the appropriate types (where N is the key of
 124 an L<FS::phone_type> record identifying the type of number: daytime, night,
 125 etc.).
 126
 127 After inserting the record, if the object has a 'custnum' or 'prospectnum'
 128 field, an L<FS::cust_contact> or L<FS::prospect_contact> record will be
 129 created to link the contact to the customer. The following fields will also
 130 be included in that record, if they are set on the object:
 131 - classnum
 132 - comment
 133 - selfservice_access
 134 - invoice_dest
 135
 136 =cut
 137
 138 sub insert {
 139   my $self = shift;
 140
 141   local $SIG{INT} = 'IGNORE';
 142   local $SIG{QUIT} = 'IGNORE';
 143   local $SIG{TERM} = 'IGNORE';
 144   local $SIG{TSTP} = 'IGNORE';
 145   local $SIG{PIPE} = 'IGNORE';
 146
 147   my $oldAutoCommit = $FS::UID::AutoCommit;
 148   local $FS::UID::AutoCommit = 0;
 149   my $dbh = dbh;
 150
 151   #save off and blank values that move to cust_contact / prospect_contact now
 152   my $prospectnum = $self->prospectnum;
 153   $self->prospectnum('');
 154   my $custnum = $self->custnum;
 155   $self->custnum('');
 156
 157   my %link_hash = ();
 158   for (qw( classnum comment selfservice_access invoice_dest message_dest)) {
 159     $link_hash{$_} = $self->get($_);
 160     $self->$_('');
 161   }
 162
 163   #look for an existing contact with this email address
 164   my $existing_contact = '';
 165   if ( $self->get('emailaddress') =~ /\S/ ) {
 166
 167     my %existing_contact = ();
 168
 169     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 170
 171       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
 172         or next;
 173
 174       my $contact = $contact_email->contact;
 175       $existing_contact{ $contact->contactnum } = $contact;
 176
 177     }
 178
 179     if ( scalar( keys %existing_contact ) > 1 ) {
 180       $dbh->rollback if $oldAutoCommit;
 181       return 'Multiple email addresses specified '.
 182              ' that already belong to separate contacts';
 183     } elsif ( scalar( keys %existing_contact ) ) {
 184       ($existing_contact) = values %existing_contact;
 185     }
 186
 187   }
 188
 189   my $error;
 190   if ( $existing_contact ) {
 191
 192     $self->$_($existing_contact->$_())
 193       for qw( contactnum _password _password_encoding );
 194     $error = $self->SUPER::replace($existing_contact);
 195
 196   } else {
 197
 198     $error = $self->SUPER::insert;
 199
 200   }
 201
 202   if ( $error ) {
 203     $dbh->rollback if $oldAutoCommit;
 204     return $error;
 205   }
 206
 207   my $cust_contact = '';
 208   # if $self->custnum was set, then the customer-specific properties
 209   # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
 210   # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
 211   # fields.
 212   if ( $custnum ) {
 213     my %hash = ( 'contactnum' => $self->contactnum,
 214                  'custnum'    => $custnum,
 215                );
 216     $cust_contact =  qsearchs('cust_contact', \%hash )
 217                   || new FS::cust_contact { %hash, %link_hash };
 218     my $error = $cust_contact->custcontactnum ? $cust_contact->replace
 219                                               : $cust_contact->insert;
 220     if ( $error ) {
 221       $dbh->rollback if $oldAutoCommit;
 222       return $error;
 223     }
 224   }
 225
 226   if ( $prospectnum ) {
 227     my %hash = ( 'contactnum'  => $self->contactnum,
 228                  'prospectnum' => $prospectnum,
 229                );
 230     my $prospect_contact =  qsearchs('prospect_contact', \%hash )
 231                          || new FS::prospect_contact { %hash, %link_hash };
 232     my $error =
 233       $prospect_contact->prospectcontactnum ? $prospect_contact->replace
 234                                             : $prospect_contact->insert;
 235     if ( $error ) {
 236       $dbh->rollback if $oldAutoCommit;
 237       return $error;
 238     }
 239   }
 240
 241   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 242                         keys %{ $self->hashref } ) {
 243     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 244     my $phonetypenum = $1;
 245
 246     my %hash = ( 'contactnum'   => $self->contactnum,
 247                  'phonetypenum' => $phonetypenum,
 248                );
 249     my $contact_phone =
 250       qsearchs('contact_phone', \%hash)
 251         || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
 252     my $error = $contact_phone->contactphonenum ? $contact_phone->replace
 253                                                 : $contact_phone->insert;
 254     if ( $error ) {
 255       $dbh->rollback if $oldAutoCommit;
 256       return $error;
 257     }
 258   }
 259
 260   if ( $self->get('emailaddress') =~ /\S/ ) {
 261
 262     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 263       my %hash = (
 264         'contactnum'   => $self->contactnum,
 265         'emailaddress' => $email,
 266       );
 267       unless ( qsearchs('contact_email', \%hash) ) {
 268         my $contact_email = new FS::contact_email \%hash;
 269         my $error = $contact_email->insert;
 270         if ( $error ) {
 271           $dbh->rollback if $oldAutoCommit;
 272           return $error;
 273         }
 274       }
 275     }
 276
 277   }
 278
 279   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 280     #warn "  queueing fuzzyfiles update\n"
 281     #  if $DEBUG > 1;
 282     my $error = $self->queue_fuzzyfiles_update;
 283     if ( $error ) {
 284       $dbh->rollback if $oldAutoCommit;
 285       return "updating fuzzy search cache: $error";
 286     }
 287   }
 288
 289   if (      $link_hash{'selfservice_access'} eq 'R'
 290        or ( $link_hash{'selfservice_access'}
 291             && $cust_contact
 292             && ! length($self->_password)
 293           )
 294      )
 295   {
 296     my $error = $self->send_reset_email( queue=>1 );
 297     if ( $error ) {
 298       $dbh->rollback if $oldAutoCommit;
 299       return $error;
 300     }
 301   }
 302
 303   if ( $self->get('password') ) {
 304     my $error = $self->is_password_allowed($self->get('password'))
 305           ||  $self->change_password($self->get('password'));
 306     if ( $error ) {
 307       $dbh->rollback if $oldAutoCommit;
 308       return $error;
 309     }
 310   }
 311
 312   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 313
 314   '';
 315
 316 }
 317
 318 =item delete
 319
 320 Delete this record from the database.
 321
 322 =cut
 323
 324 sub delete {
 325   my $self = shift;
 326
 327   local $SIG{HUP} = 'IGNORE';
 328   local $SIG{INT} = 'IGNORE';
 329   local $SIG{QUIT} = 'IGNORE';
 330   local $SIG{TERM} = 'IGNORE';
 331   local $SIG{TSTP} = 'IGNORE';
 332   local $SIG{PIPE} = 'IGNORE';
 333
 334   my $oldAutoCommit = $FS::UID::AutoCommit;
 335   local $FS::UID::AutoCommit = 0;
 336   my $dbh = dbh;
 337
 338   #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
 339
 340   if ( $self->prospectnum ) {
 341     my $prospect_contact = qsearchs('prospect_contact', {
 342                              'contactnum'  => $self->contactnum,
 343                              'prospectnum' => $self->prospectnum,
 344                            });
 345     my $error = $prospect_contact->delete;
 346     if ( $error ) {
 347       $dbh->rollback if $oldAutoCommit;
 348       return $error;
 349     }
 350   }
 351
 352   # if $self->custnum was set, then we're removing the contact from this
 353   # customer.
 354   if ( $self->custnum ) {
 355     my $cust_contact = qsearchs('cust_contact', {
 356                          'contactnum'  => $self->contactnum,
 357                          'custnum' => $self->custnum,
 358                        });
 359     my $error = $cust_contact->delete;
 360     if ( $error ) {
 361       $dbh->rollback if $oldAutoCommit;
 362       return $error;
 363     }
 364   }
 365
 366   # then, proceed with deletion only if the contact isn't attached to any other
 367   # prospects or customers
 368
 369   #inefficient, but how many prospects/customers can a single contact be
 370   # attached too?  (and is removing them from one a common operation?)
 371   if ( $self->prospect_contact || $self->cust_contact ) {
 372     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 373     return '';
 374   }
 375
 376   #proceed with deletion
 377
 378   foreach my $cust_pkg ( $self->cust_pkg ) {
 379     $cust_pkg->contactnum('');
 380     my $error = $cust_pkg->replace;
 381     if ( $error ) {
 382       $dbh->rollback if $oldAutoCommit;
 383       return $error;
 384     }
 385   }
 386
 387   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 388     my $error = $object->delete;
 389     if ( $error ) {
 390       $dbh->rollback if $oldAutoCommit;
 391       return $error;
 392     }
 393   }
 394
 395   my $error = $self->delete_password_history
 396            || $self->SUPER::delete;
 397   if ( $error ) {
 398     $dbh->rollback if $oldAutoCommit;
 399     return $error;
 400   }
 401
 402   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 403   '';
 404
 405 }
 406
 407 =item replace OLD_RECORD
 408
 409 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 410 returns the error, otherwise returns false.
 411
 412 =cut
 413
 414 sub replace {
 415   my $self = shift;
 416
 417   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 418               ? shift
 419               : $self->replace_old;
 420
 421   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 422
 423   local $SIG{INT} = 'IGNORE';
 424   local $SIG{QUIT} = 'IGNORE';
 425   local $SIG{TERM} = 'IGNORE';
 426   local $SIG{TSTP} = 'IGNORE';
 427   local $SIG{PIPE} = 'IGNORE';
 428
 429   my $oldAutoCommit = $FS::UID::AutoCommit;
 430   local $FS::UID::AutoCommit = 0;
 431   my $dbh = dbh;
 432
 433   #save off and blank values that move to cust_contact / prospect_contact now
 434   my $prospectnum = $self->prospectnum;
 435   $self->prospectnum('');
 436   my $custnum = $self->custnum;
 437   $self->custnum(''); $old->custnum(''); # remove because now stored cust_contact
 438
 439   my %link_hash = ();
 440   for (qw( classnum comment selfservice_access invoice_dest message_dest )) {
 441     $link_hash{$_} = $self->get($_);
 442     $old->$_('');  ##remove values from old record, causes problem with history
 443     $self->$_('');
 444   }
 445
 446   ## check for an existing contact with this email address other than current customer
 447   ## if found, just add that contact to cust_contact with link_hash credentials
 448   ## as email can not be tied to two contacts.
 449   my @contact_emails = ();
 450   my @contact_nums = ($self->contactnum,);
 451   if ( $self->get('emailaddress') =~ /\S/ ) {
 452
 453     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 454
 455       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } );
 456         unless ($contact_email) { push @contact_emails, $email; next; }
 457
 458       my $contact = $contact_email->contact;
 459       if ($contact->contactnum eq $self->contactnum) {
 460         push @contact_emails, $email;
 461       }
 462       else {
 463         push @contact_nums, $contact->contactnum;
 464       }
 465
 466     }
 467
 468     my $emails = join(' , ', @contact_emails);
 469     $self->emailaddress($emails);
 470
 471   }
 472
 473   my $error = $self->SUPER::replace($old);
 474   if ( $old->_password ne $self->_password ) {
 475     $error ||= $self->insert_password_history;
 476   }
 477   if ( $error ) {
 478     $dbh->rollback if $oldAutoCommit;
 479     return $error;
 480   }
 481
 482   my $cust_contact = '';
 483   # if $self->custnum was set, then the customer-specific properties
 484   # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
 485   # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
 486   # fields.
 487   if ( $custnum ) {
 488
 489     foreach my $contactnum (@contact_nums) {
 490
 491       my %hash = ( 'contactnum' => $contactnum, #$self->contactnum,
 492                    'custnum'    => $custnum,
 493                  );
 494       my $error;
 495       if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
 496         $cust_contact->$_($link_hash{$_}) for keys %link_hash;
 497         $error = $cust_contact->replace;
 498       } else {
 499         $cust_contact = new FS::cust_contact { %hash, %link_hash };
 500         $error = $cust_contact->insert;
 501       }
 502       if ( $error ) {
 503         $dbh->rollback if $oldAutoCommit;
 504         return $error;
 505       }
 506     }
 507   }
 508
 509   if ( $prospectnum ) {
 510     my %hash = ( 'contactnum'  => $self->contactnum,
 511                  'prospectnum' => $prospectnum,
 512                );
 513     my $error;
 514     if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
 515       $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
 516       $error = $prospect_contact->replace;
 517     } else {
 518       my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
 519       $error = $prospect_contact->insert;
 520     }
 521     if ( $error ) {
 522       $dbh->rollback if $oldAutoCommit;
 523       return $error;
 524     }
 525   }
 526
 527   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 528                         keys %{ $self->hashref } ) {
 529     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 530     my $phonetypenum = $1;
 531
 532     my %cp = ( 'contactnum'   => $self->contactnum,
 533                'phonetypenum' => $phonetypenum,
 534              );
 535     my $contact_phone = qsearchs('contact_phone', \%cp);
 536
 537     my $pv = $self->get($pf);
 538         $pv =~ s/\s//g;
 539
 540     #if new value is empty, delete old entry
 541     if (!$pv) {
 542       if ($contact_phone) {
 543         $error = $contact_phone->delete;
 544         if ( $error ) {
 545           $dbh->rollback if $oldAutoCommit;
 546           return $error;
 547         }
 548       }
 549       next;
 550     }
 551
 552     $contact_phone ||= new FS::contact_phone \%cp;
 553
 554     my %cpd = _parse_phonestring( $pv );
 555     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 556
 557     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 558
 559     $error = $contact_phone->$method;
 560     if ( $error ) {
 561       $dbh->rollback if $oldAutoCommit;
 562       return $error;
 563     }
 564   }
 565
 566   if ( defined($self->hashref->{'emailaddress'}) ) {
 567
 568     my %contact_emails = ();
 569     foreach my $contact_email ( $self->contact_email ) {
 570       $contact_emails{$contact_email->emailaddress} = '1';
 571     }
 572
 573     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 574
 575       unless ($contact_emails{$email}) {
 576         my $contact_email = new FS::contact_email {
 577           'contactnum'   => $self->contactnum,
 578           'emailaddress' => $email,
 579         };
 580         $error = $contact_email->insert;
 581         if ( $error ) {
 582           $dbh->rollback if $oldAutoCommit;
 583           return $error;
 584         }
 585       }
 586       else { delete($contact_emails{$email}); }
 587
 588     }
 589
 590     foreach my $contact_email ( $self->contact_email ) {
 591       if ($contact_emails{$contact_email->emailaddress}) {
 592         my $error = $contact_email->delete;
 593         if ( $error ) {
 594           $dbh->rollback if $oldAutoCommit;
 595           return $error;
 596         }
 597       }
 598     }
 599
 600   }
 601
 602   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 603     #warn "  queueing fuzzyfiles update\n"
 604     #  if $DEBUG > 1;
 605     $error = $self->queue_fuzzyfiles_update;
 606     if ( $error ) {
 607       $dbh->rollback if $oldAutoCommit;
 608       return "updating fuzzy search cache: $error";
 609     }
 610   }
 611
 612   if ( $cust_contact and (
 613                               (      $cust_contact->selfservice_access eq ''
 614                                   && $link_hash{selfservice_access}
 615                                   && ! length($self->_password)
 616                               )
 617                            || $cust_contact->_resend()
 618                          )
 619     )
 620   {
 621     my $error = $self->send_reset_email( queue=>1 );
 622     if ( $error ) {
 623       $dbh->rollback if $oldAutoCommit;
 624       return $error;
 625     }
 626   }
 627
 628   if ( $self->get('password') ) {
 629     my $error = $self->is_password_allowed($self->get('password'))
 630           ||  $self->change_password($self->get('password'));
 631     if ( $error ) {
 632       $dbh->rollback if $oldAutoCommit;
 633       return $error;
 634     }
 635   }
 636
 637   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 638
 639   '';
 640
 641 }
 642
 643 =item _parse_phonestring PHONENUMBER_STRING
 644
 645 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 646 with keys 'countrycode', 'phonenum' and 'extension'
 647
 648 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 649
 650 =cut
 651
 652 sub _parse_phonestring {
 653   my $value = shift;
 654
 655   my($countrycode, $extension) = ('1', '');
 656
 657   #countrycode
 658   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 659     $countrycode = $1;
 660   } else {
 661     $value =~ s/^\s*1//;
 662   }
 663   #extension
 664   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 665      $extension = $2;
 666   }
 667
 668   ( 'countrycode' => $countrycode,
 669     'phonenum'    => $value,
 670     'extension'   => $extension,
 671   );
 672 }
 673
 674 =item queue_fuzzyfiles_update
 675
 676 Used by insert & replace to update the fuzzy search cache
 677
 678 =cut
 679
 680 use FS::cust_main::Search;
 681 sub queue_fuzzyfiles_update {
 682   my $self = shift;
 683
 684   local $SIG{HUP} = 'IGNORE';
 685   local $SIG{INT} = 'IGNORE';
 686   local $SIG{QUIT} = 'IGNORE';
 687   local $SIG{TERM} = 'IGNORE';
 688   local $SIG{TSTP} = 'IGNORE';
 689   local $SIG{PIPE} = 'IGNORE';
 690
 691   my $oldAutoCommit = $FS::UID::AutoCommit;
 692   local $FS::UID::AutoCommit = 0;
 693   my $dbh = dbh;
 694
 695   foreach my $field ( 'first', 'last' ) {
 696     my $queue = new FS::queue {
 697       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 698     };
 699     my @args = "contact.$field", $self->get($field);
 700     my $error = $queue->insert( @args );
 701     if ( $error ) {
 702       $dbh->rollback if $oldAutoCommit;
 703       return "queueing job (transaction rolled back): $error";
 704     }
 705   }
 706
 707   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 708   '';
 709
 710 }
 711
 712 =item check
 713
 714 Checks all fields to make sure this is a valid contact.  If there is
 715 an error, returns the error, otherwise returns false.  Called by the insert
 716 and replace methods.
 717
 718 =cut
 719
 720 sub check {
 721   my $self = shift;
 722
 723   if ( $self->selfservice_access eq 'R' || $self->selfservice_access eq 'P' ) {
 724     $self->selfservice_access('Y');
 725     $self->_resend('Y');
 726   }
 727
 728   my $error =
 729     $self->ut_numbern('contactnum')
 730     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 731     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 732     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 733     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 734     || $self->ut_namen('last')
 735     || $self->ut_namen('first')
 736     || $self->ut_textn('title')
 737     || $self->ut_textn('comment')
 738     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 739     || $self->ut_textn('_password')
 740     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 741     || $self->ut_enum('disabled', [ '', 'Y' ])
 742   ;
 743   return $error if $error;
 744
 745   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 746
 747   return "One of first name, last name, or title must have a value"
 748     if ! grep $self->$_(), qw( first last title);
 749
 750   $self->SUPER::check;
 751 }
 752
 753 =item line
 754
 755 Returns a formatted string representing this contact, including name, title and
 756 comment.
 757
 758 =cut
 759
 760 sub line {
 761   my $self = shift;
 762   my $data = $self->first. ' '. $self->last;
 763   $data .= ', '. $self->title
 764     if $self->title;
 765   $data .= ' ('. $self->comment. ')'
 766     if $self->comment;
 767   $data;
 768 }
 769
 770 =item firstlast
 771
 772 Returns a formatted string representing this contact, with just the name.
 773
 774 =cut
 775
 776 sub firstlast {
 777   my $self = shift;
 778   $self->first . ' ' . $self->last;
 779 }
 780
 781 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
 782 #
 783 #Returns the name of this contact's class for the specified prospect or
 784 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
 785 #L<FS::contact_class>).
 786 #
 787 #=cut
 788 #
 789 #sub contact_classname {
 790 #  my( $self, $prospect_or_cust ) = @_;
 791 #
 792 #  my $link = '';
 793 #  if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
 794 #    $link = qsearchs('prospect_contact', {
 795 #              'contactnum'  => $self->contactnum,
 796 #              'prospectnum' => $prospect_or_cust->prospectnum,
 797 #            });
 798 #  } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
 799 #    $link = qsearchs('cust_contact', {
 800 #              'contactnum'  => $self->contactnum,
 801 #              'custnum'     => $prospect_or_cust->custnum,
 802 #            });
 803 #  } else {
 804 #    croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
 805 #  }
 806 #
 807 #  my $contact_class = $link->contact_class or return '';
 808 #  $contact_class->classname;
 809 #}
 810
 811 #autoloaded by FK in 4.x, but not during the upgrade
 812 sub contact_email {
 813   my $self = shift;
 814   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 815 }
 816
 817 =item by_selfservice_email EMAILADDRESS
 818
 819 Alternate search constructor (class method).  Given an email address, returns
 820 the contact for that address. If that contact doesn't have selfservice access,
 821 or there isn't one, returns the empty string.
 822
 823 =cut
 824
 825 sub by_selfservice_email {
 826   my($class, $email) = @_;
 827
 828   my $contact_email = qsearchs({
 829     'table'     => 'contact_email',
 830     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 831     'hashref'   => { 'emailaddress' => $email, },
 832     'extra_sql' => "
 833       AND ( contact.disabled IS NULL )
 834       AND EXISTS ( SELECT 1 FROM cust_contact
 835                      WHERE contact.contactnum = cust_contact.contactnum
 836                        AND cust_contact.selfservice_access = 'Y'
 837                  )
 838     ",
 839   }) or return '';
 840
 841   $contact_email->contact;
 842
 843 }
 844
 845 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 846 # and should maybe be libraried in some way for other password needs
 847
 848 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 849
 850 sub authenticate_password {
 851   my($self, $check_password) = @_;
 852
 853   if ( $self->_password_encoding eq 'bcrypt' ) {
 854
 855     my( $cost, $salt, $hash ) = split(',', $self->_password);
 856
 857     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 858                                                cost    => $cost,
 859                                                salt    => de_base64($salt),
 860                                              },
 861                                              $check_password
 862                                            )
 863                               );
 864
 865     $hash eq $check_hash;
 866
 867   } else {
 868
 869     return 0 if $self->_password eq '';
 870
 871     $self->_password eq $check_password;
 872
 873   }
 874
 875 }
 876
 877 =item change_password NEW_PASSWORD
 878
 879 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 880 not check password policy rules (see C<is_password_allowed>) and will return
 881 an error only if editing the record fails for some reason.
 882
 883 If NEW_PASSWORD is the same as the existing password, this does nothing.
 884
 885 =cut
 886
 887 sub change_password {
 888   my($self, $new_password) = @_;
 889
 890   # do nothing if the password is unchanged
 891   return if $self->authenticate_password($new_password);
 892
 893   $self->change_password_fields( $new_password );
 894
 895   $self->replace;
 896
 897 }
 898
 899 sub change_password_fields {
 900   my($self, $new_password) = @_;
 901
 902   $self->_password_encoding('bcrypt');
 903
 904   my $cost = 8;
 905
 906   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 907
 908   my $hash = bcrypt_hash( { key_nul => 1,
 909                             cost    => $cost,
 910                             salt    => $salt,
 911                           },
 912                           $new_password,
 913                         );
 914
 915   $self->_password(
 916     join(',', $cost, en_base64($salt), en_base64($hash) )
 917   );
 918
 919 }
 920
 921 # end of false laziness w/FS/FS/Auth/internal.pm
 922
 923
 924 #false laziness w/ClientAPI/MyAccount/reset_passwd
 925 use Digest::SHA qw(sha512_hex);
 926 use FS::Conf;
 927 use FS::ClientAPI_SessionCache;
 928 sub send_reset_email {
 929   my( $self, %opt ) = @_;
 930
 931   my @contact_email = $self->contact_email or return '';
 932
 933   my $reset_session = {
 934     'contactnum' => $self->contactnum,
 935     'svcnum'     => $opt{'svcnum'},
 936   };
 937
 938
 939   my $conf = new FS::Conf;
 940   my $timeout =
 941     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 942
 943   my $reset_session_id;
 944   do {
 945     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 946   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 947     #just in case
 948
 949   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 950
 951   #email it
 952
 953   my $cust_main = '';
 954   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 955   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 956
 957   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 958   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 959   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 960   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 961   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 962   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 963   my %msg_template = (
 964     'to'            => join(',', map $_->emailaddress, @contact_email ),
 965     'cust_main'     => $cust_main,
 966     'object'        => $self,
 967     'substitutions' => { 'session_id' => $reset_session_id }
 968   );
 969
 970   if ( $opt{'queue'} ) { #or should queueing just be the default?
 971
 972     my $cust_msg = $msg_template->prepare( %msg_template );
 973     my $error = $cust_msg->insert;
 974     return $error if $error;
 975     my $queue = new FS::queue {
 976       'job'     => 'FS::cust_msg::process_send',
 977       'custnum' => $cust_main ? $cust_main->custnum : '',
 978     };
 979     $queue->insert( $cust_msg->custmsgnum );
 980
 981   } else {
 982
 983     $msg_template->send( %msg_template );
 984
 985   }
 986
 987 }
 988
 989 use vars qw( $myaccount_cache );
 990 sub myaccount_cache {
 991   #my $class = shift;
 992   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 993                          'namespace' => 'FS::ClientAPI::MyAccount',
 994                        } );
 995 }
 996
 997 =item cgi_contact_fields
 998
 999 Returns a list reference containing the set of contact fields used in the web
1000 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
1001 and locationnum, as well as password fields, but including fields for
1002 contact_email and contact_phone records.)
1003
1004 =cut
1005
1006 sub cgi_contact_fields {
1007   #my $class = shift;
1008
1009   my @contact_fields = qw(
1010     classnum first last title comment emailaddress selfservice_access
1011     invoice_dest message_dest password
1012   );
1013
1014   push @contact_fields, 'phonetypenum'. $_->phonetypenum
1015     foreach qsearch({table=>'phone_type', order_by=>'weight'});
1016
1017   \@contact_fields;
1018
1019 }
1020
1021 use FS::upgrade_journal;
1022 sub _upgrade_data { #class method
1023   my ($class, %opts) = @_;
1024
1025   # before anything else, migrate contact.custnum to cust_contact records
1026   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
1027
1028     local($skip_fuzzyfiles) = 1;
1029
1030     foreach my $contact (qsearch('contact', {})) {
1031       my $error = $contact->replace;
1032       die $error if $error;
1033     }
1034
1035     FS::upgrade_journal->set_done('contact_invoice_dest');
1036   }
1037
1038
1039   # always migrate cust_main_invoice records over
1040   local $FS::cust_main::import = 1; # override require_phone and such
1041   my $search = FS::Cursor->new('cust_main_invoice', {});
1042   my %custnum_dest;
1043   while (my $cust_main_invoice = $search->fetch) {
1044     my $custnum = $cust_main_invoice->custnum;
1045     my $dest = $cust_main_invoice->dest;
1046     my $cust_main = $cust_main_invoice->cust_main;
1047
1048     if ( $dest =~ /^\d+$/ ) {
1049       my $svc_acct = FS::svc_acct->by_key($dest);
1050       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1051         if !$svc_acct;
1052       $dest = $svc_acct->email;
1053     }
1054     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1055
1056     my $error = $cust_main_invoice->delete;
1057     if ( $error ) {
1058       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1059     }
1060   }
1061
1062   foreach my $custnum (keys %custnum_dest) {
1063     my $dests = $custnum_dest{$custnum};
1064     my $cust_main = FS::cust_main->by_key($custnum);
1065     my $error = $cust_main->replace( invoicing_list => $dests );
1066     if ( $error ) {
1067       die "custnum $custnum, creating contact: $error\n";
1068     }
1069   }
1070
1071 }
1072
1073 =back
1074
1075 =head1 BUGS
1076
1077 =head1 SEE ALSO
1078
1079 L<FS::Record>, schema.html from the base documentation.
1080
1081 =cut
1082
1083 1;