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