FS/FS/contact.pm

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