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