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