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