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