FS/FS/contact.pm

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