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