FS/FS/contact.pm

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