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 = ();
 453   $contact_nums{$self->contactnum} = '1' if $self->contactnum;
 454   if ( $self->get('emailaddress') =~ /\S/ ) {
 455
 456     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 457
 458       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } );
 459         unless ($contact_email) { push @contact_emails, $email; next; }
 460
 461       my $contact = $contact_email->contact;
 462       if ($contact->contactnum eq $self->contactnum) {
 463         push @contact_emails, $email;
 464       }
 465       else {
 466         $contact_nums{$contact->contactnum} = '1';
 467       }
 468
 469     }
 470
 471     my $emails = join(' , ', @contact_emails);
 472     $self->emailaddress($emails);
 473
 474   }
 475
 476   my $error = $self->SUPER::replace($old);
 477   if ( $old->_password ne $self->_password ) {
 478     $error ||= $self->insert_password_history;
 479   }
 480   if ( $error ) {
 481     $dbh->rollback if $oldAutoCommit;
 482     return $error;
 483   }
 484
 485   my $cust_contact = '';
 486   # if $self->custnum was set, then the customer-specific properties
 487   # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
 488   # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
 489   # fields.
 490   if ( $custnum ) {
 491
 492     foreach my $contactnum (keys %contact_nums) {
 493
 494       my %hash = ( 'contactnum' => $contactnum,
 495                    'custnum'    => $custnum,
 496                  );
 497       my $error;
 498       if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
 499         $cust_contact->$_($link_hash{$_}) for keys %link_hash;
 500         $error = $cust_contact->replace;
 501       } else {
 502         $cust_contact = new FS::cust_contact { %hash, %link_hash };
 503         $error = $cust_contact->insert;
 504       }
 505       if ( $error ) {
 506         $dbh->rollback if $oldAutoCommit;
 507         return $error;
 508       }
 509     }
 510   }
 511
 512   if ( $prospectnum ) {
 513     my %hash = ( 'contactnum'  => $self->contactnum,
 514                  'prospectnum' => $prospectnum,
 515                );
 516     my $error;
 517     if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
 518       $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
 519       $error = $prospect_contact->replace;
 520     } else {
 521       my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
 522       $error = $prospect_contact->insert;
 523     }
 524     if ( $error ) {
 525       $dbh->rollback if $oldAutoCommit;
 526       return $error;
 527     }
 528   }
 529
 530   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 531                         keys %{ $self->hashref } ) {
 532     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 533     my $phonetypenum = $1;
 534
 535     my %cp = ( 'contactnum'   => $self->contactnum,
 536                'phonetypenum' => $phonetypenum,
 537              );
 538     my $contact_phone = qsearchs('contact_phone', \%cp);
 539
 540     my $pv = $self->get($pf);
 541         $pv =~ s/\s//g;
 542
 543     #if new value is empty, delete old entry
 544     if (!$pv) {
 545       if ($contact_phone) {
 546         $error = $contact_phone->delete;
 547         if ( $error ) {
 548           $dbh->rollback if $oldAutoCommit;
 549           return $error;
 550         }
 551       }
 552       next;
 553     }
 554
 555     $contact_phone ||= new FS::contact_phone \%cp;
 556
 557     my %cpd = _parse_phonestring( $pv );
 558     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 559
 560     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 561
 562     $error = $contact_phone->$method;
 563     if ( $error ) {
 564       $dbh->rollback if $oldAutoCommit;
 565       return $error;
 566     }
 567   }
 568
 569   if ( defined($self->hashref->{'emailaddress'}) ) {
 570
 571     my %contact_emails = ();
 572     foreach my $contact_email ( $self->contact_email ) {
 573       $contact_emails{$contact_email->emailaddress} = '1';
 574     }
 575
 576     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 577
 578       unless ($contact_emails{$email}) {
 579         my $contact_email = new FS::contact_email {
 580           'contactnum'   => $self->contactnum,
 581           'emailaddress' => $email,
 582         };
 583         $error = $contact_email->insert;
 584         if ( $error ) {
 585           $dbh->rollback if $oldAutoCommit;
 586           return $error;
 587         }
 588       }
 589       else { delete($contact_emails{$email}); }
 590
 591     }
 592
 593     foreach my $contact_email ( $self->contact_email ) {
 594       if ($contact_emails{$contact_email->emailaddress}) {
 595         my $error = $contact_email->delete;
 596         if ( $error ) {
 597           $dbh->rollback if $oldAutoCommit;
 598           return $error;
 599         }
 600       }
 601     }
 602
 603   }
 604
 605   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 606     #warn "  queueing fuzzyfiles update\n"
 607     #  if $DEBUG > 1;
 608     $error = $self->queue_fuzzyfiles_update;
 609     if ( $error ) {
 610       $dbh->rollback if $oldAutoCommit;
 611       return "updating fuzzy search cache: $error";
 612     }
 613   }
 614
 615   if ( $cust_contact and (
 616                               (      $cust_contact->selfservice_access eq ''
 617                                   && $link_hash{selfservice_access}
 618                                   && ! length($self->_password)
 619                               )
 620                            || $cust_contact->_resend()
 621                          )
 622     )
 623   {
 624     my $error = $self->send_reset_email( queue=>1 );
 625     if ( $error ) {
 626       $dbh->rollback if $oldAutoCommit;
 627       return $error;
 628     }
 629   }
 630
 631   if ( $self->get('password') ) {
 632     my $error = $self->is_password_allowed($self->get('password'))
 633           ||  $self->change_password($self->get('password'));
 634     if ( $error ) {
 635       $dbh->rollback if $oldAutoCommit;
 636       return $error;
 637     }
 638   }
 639
 640   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 641
 642   '';
 643
 644 }
 645
 646 =item _parse_phonestring PHONENUMBER_STRING
 647
 648 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 649 with keys 'countrycode', 'phonenum' and 'extension'
 650
 651 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 652
 653 =cut
 654
 655 sub _parse_phonestring {
 656   my $value = shift;
 657
 658   my($countrycode, $extension) = ('1', '');
 659
 660   #countrycode
 661   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 662     $countrycode = $1;
 663   } else {
 664     $value =~ s/^\s*1//;
 665   }
 666   #extension
 667   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 668      $extension = $2;
 669   }
 670
 671   ( 'countrycode' => $countrycode,
 672     'phonenum'    => $value,
 673     'extension'   => $extension,
 674   );
 675 }
 676
 677 =item queue_fuzzyfiles_update
 678
 679 Used by insert & replace to update the fuzzy search cache
 680
 681 =cut
 682
 683 use FS::cust_main::Search;
 684 sub queue_fuzzyfiles_update {
 685   my $self = shift;
 686
 687   local $SIG{HUP} = 'IGNORE';
 688   local $SIG{INT} = 'IGNORE';
 689   local $SIG{QUIT} = 'IGNORE';
 690   local $SIG{TERM} = 'IGNORE';
 691   local $SIG{TSTP} = 'IGNORE';
 692   local $SIG{PIPE} = 'IGNORE';
 693
 694   my $oldAutoCommit = $FS::UID::AutoCommit;
 695   local $FS::UID::AutoCommit = 0;
 696   my $dbh = dbh;
 697
 698   foreach my $field ( 'first', 'last' ) {
 699     my $queue = new FS::queue {
 700       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 701     };
 702     my @args = "contact.$field", $self->get($field);
 703     my $error = $queue->insert( @args );
 704     if ( $error ) {
 705       $dbh->rollback if $oldAutoCommit;
 706       return "queueing job (transaction rolled back): $error";
 707     }
 708   }
 709
 710   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 711   '';
 712
 713 }
 714
 715 =item check
 716
 717 Checks all fields to make sure this is a valid contact.  If there is
 718 an error, returns the error, otherwise returns false.  Called by the insert
 719 and replace methods.
 720
 721 =cut
 722
 723 sub check {
 724   my $self = shift;
 725
 726   if ( $self->selfservice_access eq 'R' || $self->selfservice_access eq 'P' ) {
 727     $self->selfservice_access('Y');
 728     $self->_resend('Y');
 729   }
 730
 731   my $error =
 732     $self->ut_numbern('contactnum')
 733     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 734     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 735     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 736     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 737     || $self->ut_namen('last')
 738     || $self->ut_namen('first')
 739     || $self->ut_textn('title')
 740     || $self->ut_textn('comment')
 741     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 742     || $self->ut_textn('_password')
 743     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 744     || $self->ut_enum('disabled', [ '', 'Y' ])
 745   ;
 746   return $error if $error;
 747
 748   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 749
 750   return "One of first name, last name, or title must have a value"
 751     if ! grep $self->$_(), qw( first last title);
 752
 753   $self->SUPER::check;
 754 }
 755
 756 =item line
 757
 758 Returns a formatted string representing this contact, including name, title and
 759 comment.
 760
 761 =cut
 762
 763 sub line {
 764   my $self = shift;
 765   my $data = $self->first. ' '. $self->last;
 766   $data .= ', '. $self->title
 767     if $self->title;
 768   $data .= ' ('. $self->comment. ')'
 769     if $self->comment;
 770   $data;
 771 }
 772
 773 =item firstlast
 774
 775 Returns a formatted string representing this contact, with just the name.
 776
 777 =cut
 778
 779 sub firstlast {
 780   my $self = shift;
 781   $self->first . ' ' . $self->last;
 782 }
 783
 784 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
 785 #
 786 #Returns the name of this contact's class for the specified prospect or
 787 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
 788 #L<FS::contact_class>).
 789 #
 790 #=cut
 791 #
 792 #sub contact_classname {
 793 #  my( $self, $prospect_or_cust ) = @_;
 794 #
 795 #  my $link = '';
 796 #  if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
 797 #    $link = qsearchs('prospect_contact', {
 798 #              'contactnum'  => $self->contactnum,
 799 #              'prospectnum' => $prospect_or_cust->prospectnum,
 800 #            });
 801 #  } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
 802 #    $link = qsearchs('cust_contact', {
 803 #              'contactnum'  => $self->contactnum,
 804 #              'custnum'     => $prospect_or_cust->custnum,
 805 #            });
 806 #  } else {
 807 #    croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
 808 #  }
 809 #
 810 #  my $contact_class = $link->contact_class or return '';
 811 #  $contact_class->classname;
 812 #}
 813
 814 #autoloaded by FK in 4.x, but not during the upgrade
 815 sub contact_email {
 816   my $self = shift;
 817   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 818 }
 819
 820 =item by_selfservice_email EMAILADDRESS
 821
 822 Alternate search constructor (class method).  Given an email address, returns
 823 the contact for that address. If that contact doesn't have selfservice access,
 824 or there isn't one, returns the empty string.
 825
 826 =cut
 827
 828 sub by_selfservice_email {
 829   my($class, $email) = @_;
 830
 831   my $contact_email = qsearchs({
 832     'table'     => 'contact_email',
 833     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 834     'hashref'   => { 'emailaddress' => $email, },
 835     'extra_sql' => "
 836       AND ( contact.disabled IS NULL )
 837       AND EXISTS ( SELECT 1 FROM cust_contact
 838                      WHERE contact.contactnum = cust_contact.contactnum
 839                        AND cust_contact.selfservice_access = 'Y'
 840                  )
 841     ",
 842   }) or return '';
 843
 844   $contact_email->contact;
 845
 846 }
 847
 848 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 849 # and should maybe be libraried in some way for other password needs
 850
 851 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 852
 853 sub authenticate_password {
 854   my($self, $check_password) = @_;
 855
 856   if ( $self->_password_encoding eq 'bcrypt' ) {
 857
 858     my( $cost, $salt, $hash ) = split(',', $self->_password);
 859
 860     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 861                                                cost    => $cost,
 862                                                salt    => de_base64($salt),
 863                                              },
 864                                              $check_password
 865                                            )
 866                               );
 867
 868     $hash eq $check_hash;
 869
 870   } else {
 871
 872     return 0 if $self->_password eq '';
 873
 874     $self->_password eq $check_password;
 875
 876   }
 877
 878 }
 879
 880 =item change_password NEW_PASSWORD
 881
 882 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 883 not check password policy rules (see C<is_password_allowed>) and will return
 884 an error only if editing the record fails for some reason.
 885
 886 If NEW_PASSWORD is the same as the existing password, this does nothing.
 887
 888 =cut
 889
 890 sub change_password {
 891   my($self, $new_password) = @_;
 892
 893   # do nothing if the password is unchanged
 894   return if $self->authenticate_password($new_password);
 895
 896   $self->change_password_fields( $new_password );
 897
 898   $self->replace;
 899
 900 }
 901
 902 sub change_password_fields {
 903   my($self, $new_password) = @_;
 904
 905   $self->_password_encoding('bcrypt');
 906
 907   my $cost = 8;
 908
 909   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 910
 911   my $hash = bcrypt_hash( { key_nul => 1,
 912                             cost    => $cost,
 913                             salt    => $salt,
 914                           },
 915                           $new_password,
 916                         );
 917
 918   $self->_password(
 919     join(',', $cost, en_base64($salt), en_base64($hash) )
 920   );
 921
 922 }
 923
 924 # end of false laziness w/FS/FS/Auth/internal.pm
 925
 926
 927 #false laziness w/ClientAPI/MyAccount/reset_passwd
 928 use Digest::SHA qw(sha512_hex);
 929 use FS::Conf;
 930 use FS::ClientAPI_SessionCache;
 931 sub send_reset_email {
 932   my( $self, %opt ) = @_;
 933
 934   my @contact_email = $self->contact_email or return '';
 935
 936   my $reset_session = {
 937     'contactnum' => $self->contactnum,
 938     'svcnum'     => $opt{'svcnum'},
 939   };
 940
 941
 942   my $conf = new FS::Conf;
 943   my $timeout =
 944     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 945
 946   my $reset_session_id;
 947   do {
 948     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 949   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 950     #just in case
 951
 952   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 953
 954   #email it
 955
 956   my $cust_main = '';
 957   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 958   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 959
 960   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 961   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 962   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 963   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 964   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 965   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 966   my %msg_template = (
 967     'to'            => join(',', map $_->emailaddress, @contact_email ),
 968     'cust_main'     => $cust_main,
 969     'object'        => $self,
 970     'substitutions' => { 'session_id' => $reset_session_id }
 971   );
 972
 973   if ( $opt{'queue'} ) { #or should queueing just be the default?
 974
 975     my $cust_msg = $msg_template->prepare( %msg_template );
 976     my $error = $cust_msg->insert;
 977     return $error if $error;
 978     my $queue = new FS::queue {
 979       'job'     => 'FS::cust_msg::process_send',
 980       'custnum' => $cust_main ? $cust_main->custnum : '',
 981     };
 982     $queue->insert( $cust_msg->custmsgnum );
 983
 984   } else {
 985
 986     $msg_template->send( %msg_template );
 987
 988   }
 989
 990 }
 991
 992 use vars qw( $myaccount_cache );
 993 sub myaccount_cache {
 994   #my $class = shift;
 995   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 996                          'namespace' => 'FS::ClientAPI::MyAccount',
 997                        } );
 998 }
 999
1000 =item cgi_contact_fields
1001
1002 Returns a list reference containing the set of contact fields used in the web
1003 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
1004 and locationnum, as well as password fields, but including fields for
1005 contact_email and contact_phone records.)
1006
1007 =cut
1008
1009 sub cgi_contact_fields {
1010   #my $class = shift;
1011
1012   my @contact_fields = qw(
1013     classnum first last title comment emailaddress selfservice_access
1014     invoice_dest message_dest password
1015   );
1016
1017   push @contact_fields, 'phonetypenum'. $_->phonetypenum
1018     foreach qsearch({table=>'phone_type', order_by=>'weight'});
1019
1020   \@contact_fields;
1021
1022 }
1023
1024 use FS::upgrade_journal;
1025 sub _upgrade_data { #class method
1026   my ($class, %opts) = @_;
1027
1028   # before anything else, migrate contact.custnum to cust_contact records
1029   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
1030
1031     local($skip_fuzzyfiles) = 1;
1032
1033     foreach my $contact (qsearch('contact', {})) {
1034       my $error = $contact->replace;
1035       die $error if $error;
1036     }
1037
1038     FS::upgrade_journal->set_done('contact_invoice_dest');
1039   }
1040
1041
1042   # always migrate cust_main_invoice records over
1043   local $FS::cust_main::import = 1; # override require_phone and such
1044   my $search = FS::Cursor->new('cust_main_invoice', {});
1045   my %custnum_dest;
1046   while (my $cust_main_invoice = $search->fetch) {
1047     my $custnum = $cust_main_invoice->custnum;
1048     my $dest = $cust_main_invoice->dest;
1049     my $cust_main = $cust_main_invoice->cust_main;
1050
1051     if ( $dest =~ /^\d+$/ ) {
1052       my $svc_acct = FS::svc_acct->by_key($dest);
1053       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1054         if !$svc_acct;
1055       $dest = $svc_acct->email;
1056     }
1057     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1058
1059     my $error = $cust_main_invoice->delete;
1060     if ( $error ) {
1061       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1062     }
1063   }
1064
1065   foreach my $custnum (keys %custnum_dest) {
1066     my $dests = $custnum_dest{$custnum};
1067     my $cust_main = FS::cust_main->by_key($custnum);
1068     my $error = $cust_main->replace( invoicing_list => $dests );
1069     if ( $error ) {
1070       die "custnum $custnum, creating contact: $error\n";
1071     }
1072   }
1073
1074 }
1075
1076 =back
1077
1078 =head1 BUGS
1079
1080 =head1 SEE ALSO
1081
1082 L<FS::Record>, schema.html from the base documentation.
1083
1084 =cut
1085
1086 1;