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 =item by_selfservice_email EMAILADDRESS
 815
 816 Alternate search constructor (class method).  Given an email address, returns
 817 the contact for that address. If that contact doesn't have selfservice access,
 818 or there isn't one, returns the empty string.
 819
 820 =cut
 821
 822 sub by_selfservice_email {
 823   my($class, $email) = @_;
 824
 825   my $contact_email = qsearchs({
 826     'table'     => 'contact_email',
 827     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 828     'hashref'   => { 'emailaddress' => $email, },
 829     'extra_sql' => "
 830       AND ( contact.disabled IS NULL )
 831       AND EXISTS ( SELECT 1 FROM cust_contact
 832                      WHERE contact.contactnum = cust_contact.contactnum
 833                        AND cust_contact.selfservice_access = 'Y'
 834                  )
 835     ",
 836   }) or return '';
 837
 838   $contact_email->contact;
 839
 840 }
 841
 842 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 843 # and should maybe be libraried in some way for other password needs
 844
 845 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 846
 847 sub authenticate_password {
 848   my($self, $check_password) = @_;
 849
 850   if ( $self->_password_encoding eq 'bcrypt' ) {
 851
 852     my( $cost, $salt, $hash ) = split(',', $self->_password);
 853
 854     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 855                                                cost    => $cost,
 856                                                salt    => de_base64($salt),
 857                                              },
 858                                              $check_password
 859                                            )
 860                               );
 861
 862     $hash eq $check_hash;
 863
 864   } else {
 865
 866     return 0 if $self->_password eq '';
 867
 868     $self->_password eq $check_password;
 869
 870   }
 871
 872 }
 873
 874 =item change_password NEW_PASSWORD
 875
 876 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 877 not check password policy rules (see C<is_password_allowed>) and will return
 878 an error only if editing the record fails for some reason.
 879
 880 If NEW_PASSWORD is the same as the existing password, this does nothing.
 881
 882 =cut
 883
 884 sub change_password {
 885   my($self, $new_password) = @_;
 886
 887   # do nothing if the password is unchanged
 888   return if $self->authenticate_password($new_password);
 889
 890   $self->change_password_fields( $new_password );
 891
 892   $self->replace;
 893
 894 }
 895
 896 sub change_password_fields {
 897   my($self, $new_password) = @_;
 898
 899   $self->_password_encoding('bcrypt');
 900
 901   my $cost = 8;
 902
 903   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 904
 905   my $hash = bcrypt_hash( { key_nul => 1,
 906                             cost    => $cost,
 907                             salt    => $salt,
 908                           },
 909                           $new_password,
 910                         );
 911
 912   $self->_password(
 913     join(',', $cost, en_base64($salt), en_base64($hash) )
 914   );
 915
 916 }
 917
 918 # end of false laziness w/FS/FS/Auth/internal.pm
 919
 920
 921 #false laziness w/ClientAPI/MyAccount/reset_passwd
 922 use Digest::SHA qw(sha512_hex);
 923 use FS::Conf;
 924 use FS::ClientAPI_SessionCache;
 925 sub send_reset_email {
 926   my( $self, %opt ) = @_;
 927
 928   my @contact_email = $self->contact_email or return '';
 929
 930   my $reset_session = {
 931     'contactnum' => $self->contactnum,
 932     'svcnum'     => $opt{'svcnum'},
 933   };
 934
 935
 936   my $conf = new FS::Conf;
 937   my $timeout =
 938     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 939
 940   my $reset_session_id;
 941   do {
 942     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 943   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 944     #just in case
 945
 946   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 947
 948   #email it
 949
 950   my $cust_main = '';
 951   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 952   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 953
 954   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 955   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 956   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 957   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 958   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 959   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 960   my %msg_template = (
 961     'to'            => join(',', map $_->emailaddress, @contact_email ),
 962     'cust_main'     => $cust_main,
 963     'object'        => $self,
 964     'substitutions' => { 'session_id' => $reset_session_id }
 965   );
 966
 967   if ( $opt{'queue'} ) { #or should queueing just be the default?
 968
 969     my $cust_msg = $msg_template->prepare( %msg_template );
 970     my $error = $cust_msg->insert;
 971     return $error if $error;
 972     my $queue = new FS::queue {
 973       'job'     => 'FS::cust_msg::process_send',
 974       'custnum' => $cust_main ? $cust_main->custnum : '',
 975     };
 976     $queue->insert( $cust_msg->custmsgnum );
 977
 978   } else {
 979
 980     $msg_template->send( %msg_template );
 981
 982   }
 983
 984 }
 985
 986 use vars qw( $myaccount_cache );
 987 sub myaccount_cache {
 988   #my $class = shift;
 989   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 990                          'namespace' => 'FS::ClientAPI::MyAccount',
 991                        } );
 992 }
 993
 994 =item cgi_contact_fields
 995
 996 Returns a list reference containing the set of contact fields used in the web
 997 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 998 and locationnum, as well as password fields, but including fields for
 999 contact_email and contact_phone records.)
1000
1001 =cut
1002
1003 sub cgi_contact_fields {
1004   #my $class = shift;
1005
1006   my @contact_fields = qw(
1007     classnum first last title comment emailaddress selfservice_access
1008     invoice_dest message_dest password
1009   );
1010
1011   push @contact_fields, 'phonetypenum'. $_->phonetypenum
1012     foreach qsearch({table=>'phone_type', order_by=>'weight'});
1013
1014   \@contact_fields;
1015
1016 }
1017
1018 use FS::upgrade_journal;
1019 sub _upgrade_data { #class method
1020   my ($class, %opts) = @_;
1021
1022   # before anything else, migrate contact.custnum to cust_contact records
1023   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
1024
1025     local($skip_fuzzyfiles) = 1;
1026
1027     foreach my $contact (qsearch('contact', {})) {
1028       my $error = $contact->replace;
1029       die $error if $error;
1030     }
1031
1032     FS::upgrade_journal->set_done('contact_invoice_dest');
1033   }
1034
1035
1036   # always migrate cust_main_invoice records over
1037   local $FS::cust_main::import = 1; # override require_phone and such
1038   my $search = FS::Cursor->new('cust_main_invoice', {});
1039   my %custnum_dest;
1040   while (my $cust_main_invoice = $search->fetch) {
1041     my $custnum = $cust_main_invoice->custnum;
1042     my $dest = $cust_main_invoice->dest;
1043     my $cust_main = $cust_main_invoice->cust_main;
1044
1045     if ( $dest =~ /^\d+$/ ) {
1046       my $svc_acct = FS::svc_acct->by_key($dest);
1047       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1048         if !$svc_acct;
1049       $dest = $svc_acct->email;
1050     }
1051     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1052
1053     my $error = $cust_main_invoice->delete;
1054     if ( $error ) {
1055       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1056     }
1057   }
1058
1059   foreach my $custnum (keys %custnum_dest) {
1060     my $dests = $custnum_dest{$custnum};
1061     my $cust_main = FS::cust_main->by_key($custnum);
1062     my $error = $cust_main->replace( invoicing_list => $dests );
1063     if ( $error ) {
1064       die "custnum $custnum, creating contact: $error\n";
1065     }
1066   }
1067
1068 }
1069
1070 =back
1071
1072 =head1 BUGS
1073
1074 =head1 SEE ALSO
1075
1076 L<FS::Record>, schema.html from the base documentation.
1077
1078 =cut
1079
1080 1;