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