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::queue;
  14 use FS::phone_type; #for cgi_contact_fields
  15 use FS::cust_contact;
  16 use FS::prospect_contact;
  17
  18 $skip_fuzzyfiles = 0;
  19
  20 =head1 NAME
  21
  22 FS::contact - Object methods for contact records
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::contact;
  27
  28   $record = new FS::contact \%hash;
  29   $record = new FS::contact { 'column' => 'value' };
  30
  31   $error = $record->insert;
  32
  33   $error = $new_record->replace($old_record);
  34
  35   $error = $record->delete;
  36
  37   $error = $record->check;
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::contact object represents an specific contact person for a prospect or
  42 customer.  FS::contact inherits from FS::Record.  The following fields are
  43 currently supported:
  44
  45 =over 4
  46
  47 =item contactnum
  48
  49 primary key
  50
  51 =item prospectnum
  52
  53 prospectnum
  54
  55 =item custnum
  56
  57 custnum
  58
  59 =item locationnum
  60
  61 locationnum
  62
  63 =item last
  64
  65 last
  66
  67 =item first
  68
  69 first
  70
  71 =item title
  72
  73 title
  74
  75 =item comment
  76
  77 comment
  78
  79 =item selfservice_access
  80
  81 empty or Y
  82
  83 =item _password
  84
  85 =item _password_encoding
  86
  87 empty or bcrypt
  88
  89 =item disabled
  90
  91 disabled
  92
  93 =back
  94
  95 =head1 METHODS
  96
  97 =over 4
  98
  99 =item new HASHREF
 100
 101 Creates a new contact.  To add the contact to the database, see L<"insert">.
 102
 103 Note that this stores the hash reference, not a distinct copy of the hash it
 104 points to.  You can ask the object for a copy with the I<hash> method.
 105
 106 =cut
 107
 108 sub table { 'contact'; }
 109
 110 =item insert
 111
 112 Adds this record to the database.  If there is an error, returns the error,
 113 otherwise returns false.
 114
 115 If the object has an C<emailaddress> field, L<FS::contact_email> records will
 116 be created for each (comma-separated) email address in that field. If any of
 117 these coincide with an existing email address, this contact will be merged with
 118 the contact with that address.
 119
 120 Then, if the object has any fields named C<phonetypenumN> an
 121 L<FS::contact_phone> record will be created for each of them. Those fields
 122 should contain phone numbers of the appropriate types (where N is the key of
 123 an L<FS::phone_type> record identifying the type of number: daytime, night,
 124 etc.).
 125
 126 After inserting the record, if the object has a 'custnum' or 'prospectnum'
 127 field, an L<FS::cust_contact> or L<FS::prospect_contact> record will be
 128 created to link the contact to the customer. The following fields will also
 129 be included in that record, if they are set on the object:
 130 - classnum
 131 - comment
 132 - selfservice_access
 133 - invoice_dest
 134
 135 =cut
 136
 137 sub insert {
 138   my $self = shift;
 139
 140   local $SIG{INT} = 'IGNORE';
 141   local $SIG{QUIT} = 'IGNORE';
 142   local $SIG{TERM} = 'IGNORE';
 143   local $SIG{TSTP} = 'IGNORE';
 144   local $SIG{PIPE} = 'IGNORE';
 145
 146   my $oldAutoCommit = $FS::UID::AutoCommit;
 147   local $FS::UID::AutoCommit = 0;
 148   my $dbh = dbh;
 149
 150   #save off and blank values that move to cust_contact / prospect_contact now
 151   my $prospectnum = $self->prospectnum;
 152   $self->prospectnum('');
 153   my $custnum = $self->custnum;
 154   $self->custnum('');
 155
 156   my %link_hash = ();
 157   for (qw( classnum comment selfservice_access invoice_dest )) {
 158     $link_hash{$_} = $self->get($_);
 159     $self->$_('');
 160   }
 161
 162   #look for an existing contact with this email address
 163   my $existing_contact = '';
 164   if ( $self->get('emailaddress') =~ /\S/ ) {
 165
 166     my %existing_contact = ();
 167
 168     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 169
 170       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
 171         or next;
 172
 173       my $contact = $contact_email->contact;
 174       $existing_contact{ $contact->contactnum } = $contact;
 175
 176     }
 177
 178     if ( scalar( keys %existing_contact ) > 1 ) {
 179       $dbh->rollback if $oldAutoCommit;
 180       return 'Multiple email addresses specified '.
 181              ' that already belong to separate contacts';
 182     } elsif ( scalar( keys %existing_contact ) ) {
 183       ($existing_contact) = values %existing_contact;
 184     }
 185
 186   }
 187
 188   my $error;
 189   if ( $existing_contact ) {
 190
 191     $self->$_($existing_contact->$_())
 192       for qw( contactnum _password _password_encoding );
 193     $error = $self->SUPER::replace($existing_contact);
 194
 195   } else {
 196
 197     $error = $self->SUPER::insert;
 198
 199   }
 200
 201   $error ||= $self->insert_password_history;
 202
 203   if ( $error ) {
 204     $dbh->rollback if $oldAutoCommit;
 205     return $error;
 206   }
 207
 208   my $cust_contact = '';
 209   if ( $custnum ) {
 210     my %hash = ( 'contactnum' => $self->contactnum,
 211                  'custnum'    => $custnum,
 212                );
 213     $cust_contact =  qsearchs('cust_contact', \%hash )
 214                   || new FS::cust_contact { %hash, %link_hash };
 215     my $error = $cust_contact->custcontactnum ? $cust_contact->replace
 216                                               : $cust_contact->insert;
 217     if ( $error ) {
 218       $dbh->rollback if $oldAutoCommit;
 219       return $error;
 220     }
 221   }
 222
 223   if ( $prospectnum ) {
 224     my %hash = ( 'contactnum'  => $self->contactnum,
 225                  'prospectnum' => $prospectnum,
 226                );
 227     my $prospect_contact =  qsearchs('prospect_contact', \%hash )
 228                          || new FS::prospect_contact { %hash, %link_hash };
 229     my $error =
 230       $prospect_contact->prospectcontactnum ? $prospect_contact->replace
 231                                             : $prospect_contact->insert;
 232     if ( $error ) {
 233       $dbh->rollback if $oldAutoCommit;
 234       return $error;
 235     }
 236   }
 237
 238   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 239                         keys %{ $self->hashref } ) {
 240     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 241     my $phonetypenum = $1;
 242
 243     my %hash = ( 'contactnum'   => $self->contactnum,
 244                  'phonetypenum' => $phonetypenum,
 245                );
 246     my $contact_phone =
 247       qsearchs('contact_phone', \%hash)
 248         || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
 249     my $error = $contact_phone->contactphonenum ? $contact_phone->replace
 250                                                 : $contact_phone->insert;
 251     if ( $error ) {
 252       $dbh->rollback if $oldAutoCommit;
 253       return $error;
 254     }
 255   }
 256
 257   if ( $self->get('emailaddress') =~ /\S/ ) {
 258
 259     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 260       my %hash = (
 261         'contactnum'   => $self->contactnum,
 262         'emailaddress' => $email,
 263       );
 264       unless ( qsearchs('contact_email', \%hash) ) {
 265         my $contact_email = new FS::contact_email \%hash;
 266         my $error = $contact_email->insert;
 267         if ( $error ) {
 268           $dbh->rollback if $oldAutoCommit;
 269           return $error;
 270         }
 271       }
 272     }
 273
 274   }
 275
 276   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 277     #warn "  queueing fuzzyfiles update\n"
 278     #  if $DEBUG > 1;
 279     my $error = $self->queue_fuzzyfiles_update;
 280     if ( $error ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return "updating fuzzy search cache: $error";
 283     }
 284   }
 285
 286   if (      $link_hash{'selfservice_access'} eq 'R'
 287        or ( $link_hash{'selfservice_access'}
 288             && $cust_contact
 289             && ! length($self->_password)
 290           )
 291      )
 292   {
 293     my $error = $self->send_reset_email( queue=>1 );
 294     if ( $error ) {
 295       $dbh->rollback if $oldAutoCommit;
 296       return $error;
 297     }
 298   }
 299
 300   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 301
 302   '';
 303
 304 }
 305
 306 =item delete
 307
 308 Delete this record from the database.
 309
 310 =cut
 311
 312 sub delete {
 313   my $self = shift;
 314
 315   local $SIG{HUP} = 'IGNORE';
 316   local $SIG{INT} = 'IGNORE';
 317   local $SIG{QUIT} = 'IGNORE';
 318   local $SIG{TERM} = 'IGNORE';
 319   local $SIG{TSTP} = 'IGNORE';
 320   local $SIG{PIPE} = 'IGNORE';
 321
 322   my $oldAutoCommit = $FS::UID::AutoCommit;
 323   local $FS::UID::AutoCommit = 0;
 324   my $dbh = dbh;
 325
 326   #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
 327
 328   if ( $self->prospectnum ) {
 329     my $prospect_contact = qsearchs('prospect_contact', {
 330                              'contactnum'  => $self->contactnum,
 331                              'prospectnum' => $self->prospectnum,
 332                            });
 333     my $error = $prospect_contact->delete;
 334     if ( $error ) {
 335       $dbh->rollback if $oldAutoCommit;
 336       return $error;
 337     }
 338   }
 339
 340   if ( $self->custnum ) {
 341     my $cust_contact = qsearchs('cust_contact', {
 342                          'contactnum'  => $self->contactnum,
 343                          'custnum' => $self->custnum,
 344                        });
 345     my $error = $cust_contact->delete;
 346     if ( $error ) {
 347       $dbh->rollback if $oldAutoCommit;
 348       return $error;
 349     }
 350   }
 351
 352   # then, proceed with deletion only if the contact isn't attached to any other
 353   # prospects or customers
 354
 355   #inefficient, but how many prospects/customers can a single contact be
 356   # attached too?  (and is removing them from one a common operation?)
 357   if ( $self->prospect_contact || $self->cust_contact ) {
 358     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 359     return '';
 360   }
 361
 362   #proceed with deletion
 363
 364   foreach my $cust_pkg ( $self->cust_pkg ) {
 365     $cust_pkg->contactnum('');
 366     my $error = $cust_pkg->replace;
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371   }
 372
 373   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 374     my $error = $object->delete;
 375     if ( $error ) {
 376       $dbh->rollback if $oldAutoCommit;
 377       return $error;
 378     }
 379   }
 380
 381   my $error = $self->SUPER::delete;
 382   if ( $error ) {
 383     $dbh->rollback if $oldAutoCommit;
 384     return $error;
 385   }
 386
 387   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 388   '';
 389
 390 }
 391
 392 =item replace OLD_RECORD
 393
 394 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 395 returns the error, otherwise returns false.
 396
 397 =cut
 398
 399 sub replace {
 400   my $self = shift;
 401
 402   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 403               ? shift
 404               : $self->replace_old;
 405
 406   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 407
 408   local $SIG{INT} = 'IGNORE';
 409   local $SIG{QUIT} = 'IGNORE';
 410   local $SIG{TERM} = 'IGNORE';
 411   local $SIG{TSTP} = 'IGNORE';
 412   local $SIG{PIPE} = 'IGNORE';
 413
 414   my $oldAutoCommit = $FS::UID::AutoCommit;
 415   local $FS::UID::AutoCommit = 0;
 416   my $dbh = dbh;
 417
 418   #save off and blank values that move to cust_contact / prospect_contact now
 419   my $prospectnum = $self->prospectnum;
 420   $self->prospectnum('');
 421   my $custnum = $self->custnum;
 422   $self->custnum('');
 423
 424   my %link_hash = ();
 425   for (qw( classnum comment selfservice_access invoice_dest )) {
 426     $link_hash{$_} = $self->get($_);
 427     $self->$_('');
 428   }
 429
 430   my $error = $self->SUPER::replace($old);
 431   if ( $old->_password ne $self->_password ) {
 432     $error ||= $self->insert_password_history;
 433   }
 434   if ( $error ) {
 435     $dbh->rollback if $oldAutoCommit;
 436     return $error;
 437   }
 438
 439   my $cust_contact = '';
 440   if ( $custnum ) {
 441     my %hash = ( 'contactnum' => $self->contactnum,
 442                  'custnum'    => $custnum,
 443                );
 444     my $error;
 445     if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
 446       $cust_contact->$_($link_hash{$_}) for keys %link_hash;
 447       $error = $cust_contact->replace;
 448     } else {
 449       $cust_contact = new FS::cust_contact { %hash, %link_hash };
 450       $error = $cust_contact->insert;
 451     }
 452     if ( $error ) {
 453       $dbh->rollback if $oldAutoCommit;
 454       return $error;
 455     }
 456   }
 457
 458   if ( $prospectnum ) {
 459     my %hash = ( 'contactnum'  => $self->contactnum,
 460                  'prospectnum' => $prospectnum,
 461                );
 462     my $error;
 463     if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
 464       $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
 465       $error = $prospect_contact->replace;
 466     } else {
 467       my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
 468       $error = $prospect_contact->insert;
 469     }
 470     if ( $error ) {
 471       $dbh->rollback if $oldAutoCommit;
 472       return $error;
 473     }
 474   }
 475
 476   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 477                         keys %{ $self->hashref } ) {
 478     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 479     my $phonetypenum = $1;
 480
 481     my %cp = ( 'contactnum'   => $self->contactnum,
 482                'phonetypenum' => $phonetypenum,
 483              );
 484     my $contact_phone = qsearchs('contact_phone', \%cp);
 485
 486     my $pv = $self->get($pf);
 487         $pv =~ s/\s//g;
 488
 489     #if new value is empty, delete old entry
 490     if (!$pv) {
 491       if ($contact_phone) {
 492         $error = $contact_phone->delete;
 493         if ( $error ) {
 494           $dbh->rollback if $oldAutoCommit;
 495           return $error;
 496         }
 497       }
 498       next;
 499     }
 500
 501     $contact_phone ||= new FS::contact_phone \%cp;
 502
 503     my %cpd = _parse_phonestring( $pv );
 504     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 505
 506     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 507
 508     $error = $contact_phone->$method;
 509     if ( $error ) {
 510       $dbh->rollback if $oldAutoCommit;
 511       return $error;
 512     }
 513   }
 514
 515   if ( defined($self->hashref->{'emailaddress'}) ) {
 516
 517     #ineffecient but whatever, how many email addresses can there be?
 518
 519     foreach my $contact_email ( $self->contact_email ) {
 520       my $error = $contact_email->delete;
 521       if ( $error ) {
 522         $dbh->rollback if $oldAutoCommit;
 523         return $error;
 524       }
 525     }
 526
 527     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 528
 529       my $contact_email = new FS::contact_email {
 530         'contactnum'   => $self->contactnum,
 531         'emailaddress' => $email,
 532       };
 533       $error = $contact_email->insert;
 534       if ( $error ) {
 535         $dbh->rollback if $oldAutoCommit;
 536         return $error;
 537       }
 538
 539     }
 540
 541   }
 542
 543   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 544     #warn "  queueing fuzzyfiles update\n"
 545     #  if $DEBUG > 1;
 546     $error = $self->queue_fuzzyfiles_update;
 547     if ( $error ) {
 548       $dbh->rollback if $oldAutoCommit;
 549       return "updating fuzzy search cache: $error";
 550     }
 551   }
 552
 553   if ( $cust_contact and (
 554                               (      $cust_contact->selfservice_access eq ''
 555                                   && $link_hash{selfservice_access}
 556                                   && ! length($self->_password)
 557                               )
 558                            || $cust_contact->_resend()
 559                          )
 560     )
 561   {
 562     my $error = $self->send_reset_email( queue=>1 );
 563     if ( $error ) {
 564       $dbh->rollback if $oldAutoCommit;
 565       return $error;
 566     }
 567   }
 568
 569   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 570
 571   '';
 572
 573 }
 574
 575 =item _parse_phonestring PHONENUMBER_STRING
 576
 577 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 578 with keys 'countrycode', 'phonenum' and 'extension'
 579
 580 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 581
 582 =cut
 583
 584 sub _parse_phonestring {
 585   my $value = shift;
 586
 587   my($countrycode, $extension) = ('1', '');
 588
 589   #countrycode
 590   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 591     $countrycode = $1;
 592   } else {
 593     $value =~ s/^\s*1//;
 594   }
 595   #extension
 596   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 597      $extension = $2;
 598   }
 599
 600   ( 'countrycode' => $countrycode,
 601     'phonenum'    => $value,
 602     'extension'   => $extension,
 603   );
 604 }
 605
 606 =item queue_fuzzyfiles_update
 607
 608 Used by insert & replace to update the fuzzy search cache
 609
 610 =cut
 611
 612 use FS::cust_main::Search;
 613 sub queue_fuzzyfiles_update {
 614   my $self = shift;
 615
 616   local $SIG{HUP} = 'IGNORE';
 617   local $SIG{INT} = 'IGNORE';
 618   local $SIG{QUIT} = 'IGNORE';
 619   local $SIG{TERM} = 'IGNORE';
 620   local $SIG{TSTP} = 'IGNORE';
 621   local $SIG{PIPE} = 'IGNORE';
 622
 623   my $oldAutoCommit = $FS::UID::AutoCommit;
 624   local $FS::UID::AutoCommit = 0;
 625   my $dbh = dbh;
 626
 627   foreach my $field ( 'first', 'last' ) {
 628     my $queue = new FS::queue {
 629       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 630     };
 631     my @args = "contact.$field", $self->get($field);
 632     my $error = $queue->insert( @args );
 633     if ( $error ) {
 634       $dbh->rollback if $oldAutoCommit;
 635       return "queueing job (transaction rolled back): $error";
 636     }
 637   }
 638
 639   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 640   '';
 641
 642 }
 643
 644 =item check
 645
 646 Checks all fields to make sure this is a valid contact.  If there is
 647 an error, returns the error, otherwise returns false.  Called by the insert
 648 and replace methods.
 649
 650 =cut
 651
 652 sub check {
 653   my $self = shift;
 654
 655   if ( $self->selfservice_access eq 'R' ) {
 656     $self->selfservice_access('Y');
 657     $self->_resend('Y');
 658   }
 659
 660   my $error =
 661     $self->ut_numbern('contactnum')
 662     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 663     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 664     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 665     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 666     || $self->ut_namen('last')
 667     || $self->ut_namen('first')
 668     || $self->ut_textn('title')
 669     || $self->ut_textn('comment')
 670     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 671     || $self->ut_textn('_password')
 672     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 673     || $self->ut_enum('disabled', [ '', 'Y' ])
 674   ;
 675   return $error if $error;
 676
 677   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 678
 679   return "One of first name, last name, or title must have a value"
 680     if ! grep $self->$_(), qw( first last title);
 681
 682   $self->SUPER::check;
 683 }
 684
 685 =item line
 686
 687 Returns a formatted string representing this contact, including name, title and
 688 comment.
 689
 690 =cut
 691
 692 sub line {
 693   my $self = shift;
 694   my $data = $self->first. ' '. $self->last;
 695   $data .= ', '. $self->title
 696     if $self->title;
 697   $data .= ' ('. $self->comment. ')'
 698     if $self->comment;
 699   $data;
 700 }
 701
 702 =item firstlast
 703
 704 Returns a formatted string representing this contact, with just the name.
 705
 706 =cut
 707
 708 sub firstlast {
 709   my $self = shift;
 710   $self->first . ' ' . $self->last;
 711 }
 712
 713 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
 714 #
 715 #Returns the name of this contact's class for the specified prospect or
 716 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
 717 #L<FS::contact_class>).
 718 #
 719 #=cut
 720 #
 721 #sub contact_classname {
 722 #  my( $self, $prospect_or_cust ) = @_;
 723 #
 724 #  my $link = '';
 725 #  if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
 726 #    $link = qsearchs('prospect_contact', {
 727 #              'contactnum'  => $self->contactnum,
 728 #              'prospectnum' => $prospect_or_cust->prospectnum,
 729 #            });
 730 #  } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
 731 #    $link = qsearchs('cust_contact', {
 732 #              'contactnum'  => $self->contactnum,
 733 #              'custnum'     => $prospect_or_cust->custnum,
 734 #            });
 735 #  } else {
 736 #    croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
 737 #  }
 738 #
 739 #  my $contact_class = $link->contact_class or return '';
 740 #  $contact_class->classname;
 741 #}
 742
 743 =item by_selfservice_email EMAILADDRESS
 744
 745 Alternate search constructor (class method).  Given an email address,
 746 returns the contact for that address, or the empty string if no contact
 747 has that email address.
 748
 749 =cut
 750
 751 sub by_selfservice_email {
 752   my($class, $email) = @_;
 753
 754   my $contact_email = qsearchs({
 755     'table'     => 'contact_email',
 756     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 757     'hashref'   => { 'emailaddress' => $email, },
 758     'extra_sql' => " AND ( disabled IS NULL OR disabled = '' )",
 759   }) or return '';
 760
 761   $contact_email->contact;
 762
 763 }
 764
 765 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 766 # and should maybe be libraried in some way for other password needs
 767
 768 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 769
 770 sub authenticate_password {
 771   my($self, $check_password) = @_;
 772
 773   if ( $self->_password_encoding eq 'bcrypt' ) {
 774
 775     my( $cost, $salt, $hash ) = split(',', $self->_password);
 776
 777     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 778                                                cost    => $cost,
 779                                                salt    => de_base64($salt),
 780                                              },
 781                                              $check_password
 782                                            )
 783                               );
 784
 785     $hash eq $check_hash;
 786
 787   } else {
 788
 789     return 0 if $self->_password eq '';
 790
 791     $self->_password eq $check_password;
 792
 793   }
 794
 795 }
 796
 797 =item change_password NEW_PASSWORD
 798
 799 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 800 not check password policy rules (see C<is_password_allowed>) and will return
 801 an error only if editing the record fails for some reason.
 802
 803 If NEW_PASSWORD is the same as the existing password, this does nothing.
 804
 805 =cut
 806
 807 sub change_password {
 808   my($self, $new_password) = @_;
 809
 810   # do nothing if the password is unchanged
 811   return if $self->authenticate_password($new_password);
 812
 813   $self->change_password_fields( $new_password );
 814
 815   $self->replace;
 816
 817 }
 818
 819 sub change_password_fields {
 820   my($self, $new_password) = @_;
 821
 822   $self->_password_encoding('bcrypt');
 823
 824   my $cost = 8;
 825
 826   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 827
 828   my $hash = bcrypt_hash( { key_nul => 1,
 829                             cost    => $cost,
 830                             salt    => $salt,
 831                           },
 832                           $new_password,
 833                         );
 834
 835   $self->_password(
 836     join(',', $cost, en_base64($salt), en_base64($hash) )
 837   );
 838
 839 }
 840
 841 # end of false laziness w/FS/FS/Auth/internal.pm
 842
 843
 844 #false laziness w/ClientAPI/MyAccount/reset_passwd
 845 use Digest::SHA qw(sha512_hex);
 846 use FS::Conf;
 847 use FS::ClientAPI_SessionCache;
 848 sub send_reset_email {
 849   my( $self, %opt ) = @_;
 850
 851   my @contact_email = $self->contact_email or return '';
 852
 853   my $reset_session = {
 854     'contactnum' => $self->contactnum,
 855     'svcnum'     => $opt{'svcnum'},
 856   };
 857
 858   my $timeout = '24 hours'; #?
 859
 860   my $reset_session_id;
 861   do {
 862     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 863   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 864     #just in case
 865
 866   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 867
 868   #email it
 869
 870   my $conf = new FS::Conf;
 871
 872   my $cust_main = '';
 873   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 874   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 875
 876   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 877   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 878   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 879   return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
 880   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 881   return { 'error' => "selfservice-password_reset_msgnum cannot be loaded" } unless $msg_template;
 882   my %msg_template = (
 883     'to'            => join(',', map $_->emailaddress, @contact_email ),
 884     'cust_main'     => $cust_main,
 885     'object'        => $self,
 886     'substitutions' => { 'session_id' => $reset_session_id }
 887   );
 888
 889   if ( $opt{'queue'} ) { #or should queueing just be the default?
 890
 891     my $cust_msg = $msg_template->prepare( %msg_template );
 892     my $error = $cust_msg->insert;
 893     return { 'error' => $error } if $error;
 894     my $queue = new FS::queue {
 895       'job'     => 'FS::cust_msg::process_send',
 896       'custnum' => $cust_main ? $cust_main->custnum : '',
 897     };
 898     $queue->insert( $cust_msg->custmsgnum );
 899
 900   } else {
 901
 902     $msg_template->send( %msg_template );
 903
 904   }
 905
 906 }
 907
 908 use vars qw( $myaccount_cache );
 909 sub myaccount_cache {
 910   #my $class = shift;
 911   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 912                          'namespace' => 'FS::ClientAPI::MyAccount',
 913                        } );
 914 }
 915
 916 =item cgi_contact_fields
 917
 918 Returns a list reference containing the set of contact fields used in the web
 919 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 920 and locationnum, as well as password fields, but including fields for
 921 contact_email and contact_phone records.)
 922
 923 =cut
 924
 925 sub cgi_contact_fields {
 926   #my $class = shift;
 927
 928   my @contact_fields = qw(
 929     classnum first last title comment emailaddress selfservice_access
 930     invoice_dest
 931   );
 932
 933   push @contact_fields, 'phonetypenum'. $_->phonetypenum
 934     foreach qsearch({table=>'phone_type', order_by=>'weight'});
 935
 936   \@contact_fields;
 937
 938 }
 939
 940 use FS::upgrade_journal;
 941 sub _upgrade_data { #class method
 942   my ($class, %opts) = @_;
 943
 944   # always migrate cust_main_invoice records over
 945   local $FS::cust_main::import = 1; # override require_phone and such
 946   my $search = FS::Cursor->new('cust_main_invoice', {});
 947   while (my $cust_main_invoice = $search->fetch) {
 948     my $custnum = $cust_main_invoice->custnum;
 949     my $dest = $cust_main_invoice->dest;
 950     my $cust_main = $cust_main_invoice->cust_main;
 951
 952     if ( $dest =~ /^\d+$/ ) {
 953       my $svc_acct = FS::svc_acct->by_key($dest);
 954       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
 955         if !$svc_acct;
 956       $dest = $svc_acct->email;
 957     }
 958
 959     my $error = $cust_main->replace( invoicing_list => [ $dest ] );
 960
 961     if ( $error ) {
 962       die "custnum $custnum, invoice destination $dest, creating contact: $error\n";
 963     }
 964
 965     $error = $cust_main_invoice->delete;
 966     die "custnum $custnum, cleaning up cust_main_invoice: $error\n" if $error;
 967
 968   } # while $search->fetch
 969
 970   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
 971
 972     foreach my $contact (qsearch('contact', {})) {
 973       my $error = $contact->replace;
 974       die $error if $error;
 975     }
 976
 977     FS::upgrade_journal->set_done('contact_invoice_dest');
 978   }
 979
 980 }
 981
 982 =back
 983
 984 =head1 BUGS
 985
 986 =head1 SEE ALSO
 987
 988 L<FS::Record>, schema.html from the base documentation.
 989
 990 =cut
 991
 992 1;
 993