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