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
 164   ## check for an existing contact with this email address other than current customer
 165   ## if found, just add that contact to cust_contact with link_hash credentials
 166   ## as email can not be tied to two contacts.
 167   my $no_new_contact;
 168   my $existing_contact = '';
 169   my @contact_emails = ();
 170   my %contact_nums = ();
 171
 172   if ( $self->get('emailaddress') =~ /\S/ ) {
 173
 174     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 175
 176       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } );
 177         unless ($contact_email) { push @contact_emails, $email; next; }
 178
 179       my $contact = $contact_email->contact;
 180       if ($contact->contactnum eq $self->contactnum) {
 181         push @contact_emails, $email;
 182       }
 183       else {
 184         $contact_nums{$contact->contactnum} = '1';
 185       }
 186
 187     }
 188
 189     my $emails = join(' , ', @contact_emails);
 190     $self->emailaddress($emails);
 191
 192     $no_new_contact = '1' unless $self->emailaddress;
 193
 194   }
 195
 196   my $error;
 197   $error = $self->SUPER::insert unless $no_new_contact;
 198
 199   if ( $error ) {
 200     $dbh->rollback if $oldAutoCommit;
 201     return $error;
 202   }
 203
 204   $contact_nums{$self->contactnum} = '1' if $self->contactnum;
 205
 206   my $cust_contact = '';
 207   # if $self->custnum was set, then the customer-specific properties
 208   # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
 209   # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
 210   # fields.
 211   if ( $custnum ) {
 212     foreach my $contactnum (keys %contact_nums) {
 213       my %hash = ( 'contactnum' => $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
 227   if ( $prospectnum && !$no_new_contact) {
 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   unless ($no_new_contact) {
 243   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 244                         keys %{ $self->hashref } ) {
 245     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 246     my $phonetypenum = $1;
 247
 248     my %hash = ( 'contactnum'   => $self->contactnum,
 249                  'phonetypenum' => $phonetypenum,
 250                );
 251     my $contact_phone =
 252       qsearchs('contact_phone', \%hash)
 253         || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
 254     my $error = $contact_phone->contactphonenum ? $contact_phone->replace
 255                                                 : $contact_phone->insert;
 256     if ( $error ) {
 257       $dbh->rollback if $oldAutoCommit;
 258       return $error;
 259     }
 260   }
 261   }
 262
 263   if ( $self->get('emailaddress') =~ /\S/ ) {
 264
 265     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 266       my %hash = (
 267         'contactnum'   => $self->contactnum,
 268         'emailaddress' => $email,
 269       );
 270       unless ( qsearchs('contact_email', \%hash) ) {
 271         my $contact_email = new FS::contact_email \%hash;
 272         my $error = $contact_email->insert;
 273         if ( $error ) {
 274           $dbh->rollback if $oldAutoCommit;
 275           return $error;
 276         }
 277       }
 278     }
 279
 280   }
 281
 282   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 283     #warn "  queueing fuzzyfiles update\n"
 284     #  if $DEBUG > 1;
 285     my $error = $self->queue_fuzzyfiles_update;
 286     if ( $error ) {
 287       $dbh->rollback if $oldAutoCommit;
 288       return "updating fuzzy search cache: $error";
 289     }
 290   }
 291
 292   if (      $link_hash{'selfservice_access'} eq 'R'
 293        or ( $link_hash{'selfservice_access'}
 294             && $cust_contact
 295             && ! length($self->_password)
 296           )
 297      )
 298   {
 299     my $error = $self->send_reset_email( queue=>1 );
 300     if ( $error ) {
 301       $dbh->rollback if $oldAutoCommit;
 302       return $error;
 303     }
 304   }
 305
 306   if ( $self->get('password') ) {
 307     my $error = $self->is_password_allowed($self->get('password'))
 308           ||  $self->change_password($self->get('password'));
 309     if ( $error ) {
 310       $dbh->rollback if $oldAutoCommit;
 311       return $error;
 312     }
 313   }
 314
 315   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 316
 317   '';
 318
 319 }
 320
 321 =item delete
 322
 323 Delete this record from the database.
 324
 325 =cut
 326
 327 sub delete {
 328   my $self = shift;
 329
 330   local $SIG{HUP} = 'IGNORE';
 331   local $SIG{INT} = 'IGNORE';
 332   local $SIG{QUIT} = 'IGNORE';
 333   local $SIG{TERM} = 'IGNORE';
 334   local $SIG{TSTP} = 'IGNORE';
 335   local $SIG{PIPE} = 'IGNORE';
 336
 337   my $oldAutoCommit = $FS::UID::AutoCommit;
 338   local $FS::UID::AutoCommit = 0;
 339   my $dbh = dbh;
 340
 341   #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
 342
 343   if ( $self->prospectnum ) {
 344     my $prospect_contact = qsearchs('prospect_contact', {
 345                              'contactnum'  => $self->contactnum,
 346                              'prospectnum' => $self->prospectnum,
 347                            });
 348     my $error = $prospect_contact->delete;
 349     if ( $error ) {
 350       $dbh->rollback if $oldAutoCommit;
 351       return $error;
 352     }
 353   }
 354
 355   # if $self->custnum was set, then we're removing the contact from this
 356   # customer.
 357   if ( $self->custnum ) {
 358     my $cust_contact = qsearchs('cust_contact', {
 359                          'contactnum'  => $self->contactnum,
 360                          'custnum' => $self->custnum,
 361                        });
 362     my $error = $cust_contact->delete;
 363     if ( $error ) {
 364       $dbh->rollback if $oldAutoCommit;
 365       return $error;
 366     }
 367   }
 368
 369   # then, proceed with deletion only if the contact isn't attached to any other
 370   # prospects or customers
 371
 372   #inefficient, but how many prospects/customers can a single contact be
 373   # attached too?  (and is removing them from one a common operation?)
 374   if ( $self->prospect_contact || $self->cust_contact ) {
 375     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 376     return '';
 377   }
 378
 379   #proceed with deletion
 380
 381   foreach my $cust_pkg ( $self->cust_pkg ) {
 382     $cust_pkg->contactnum('');
 383     my $error = $cust_pkg->replace;
 384     if ( $error ) {
 385       $dbh->rollback if $oldAutoCommit;
 386       return $error;
 387     }
 388   }
 389
 390   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 391     my $error = $object->delete;
 392     if ( $error ) {
 393       $dbh->rollback if $oldAutoCommit;
 394       return $error;
 395     }
 396   }
 397
 398   my $error = $self->delete_password_history
 399            || $self->SUPER::delete;
 400   if ( $error ) {
 401     $dbh->rollback if $oldAutoCommit;
 402     return $error;
 403   }
 404
 405   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 406   '';
 407
 408 }
 409
 410 =item replace OLD_RECORD
 411
 412 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 413 returns the error, otherwise returns false.
 414
 415 =cut
 416
 417 sub replace {
 418   my $self = shift;
 419
 420   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 421               ? shift
 422               : $self->replace_old;
 423
 424   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 425
 426   local $SIG{INT} = 'IGNORE';
 427   local $SIG{QUIT} = 'IGNORE';
 428   local $SIG{TERM} = 'IGNORE';
 429   local $SIG{TSTP} = 'IGNORE';
 430   local $SIG{PIPE} = 'IGNORE';
 431
 432   my $oldAutoCommit = $FS::UID::AutoCommit;
 433   local $FS::UID::AutoCommit = 0;
 434   my $dbh = dbh;
 435
 436   #save off and blank values that move to cust_contact / prospect_contact now
 437   my $prospectnum = $self->prospectnum;
 438   $self->prospectnum('');
 439   my $custnum = $self->custnum;
 440   $self->custnum(''); $old->custnum(''); # remove because now stored cust_contact
 441
 442   my %link_hash = ();
 443   for (qw( classnum comment selfservice_access invoice_dest message_dest )) {
 444     $link_hash{$_} = $self->get($_);
 445     $old->$_('');  ##remove values from old record, causes problem with history
 446     $self->$_('');
 447   }
 448
 449   ## check for an existing contact with this email address other than current customer
 450   ## if found, just add that contact to cust_contact with link_hash credentials
 451   ## as email can not be tied to two contacts.
 452   my @contact_emails = ();
 453   my %contact_nums = ();
 454   $contact_nums{$self->contactnum} = '1' if $self->contactnum;
 455   if ( $self->get('emailaddress') =~ /\S/ ) {
 456
 457     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 458
 459       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } );
 460         unless ($contact_email) { push @contact_emails, $email; next; }
 461
 462       my $contact = $contact_email->contact;
 463       if ($contact->contactnum eq $self->contactnum) {
 464         push @contact_emails, $email;
 465       }
 466       else {
 467         $contact_nums{$contact->contactnum} = '1';
 468       }
 469
 470     }
 471
 472     ## were all emails duplicates?  if so reset original emails
 473     if (scalar @contact_emails < 1 && scalar (keys %contact_nums) > 1) {
 474       foreach (qsearch('contact_email', {'contactnum' => $self->contactnum})) {
 475         push @contact_emails, $_->emailaddress;
 476       }
 477     }
 478
 479     my $emails = join(' , ', @contact_emails);
 480     $self->emailaddress($emails);
 481
 482   }
 483
 484   my $error = $self->SUPER::replace($old);
 485   if ( $old->_password ne $self->_password ) {
 486     $error ||= $self->insert_password_history;
 487   }
 488   if ( $error ) {
 489     $dbh->rollback if $oldAutoCommit;
 490     return $error;
 491   }
 492
 493   my $cust_contact = '';
 494   # if $self->custnum was set, then the customer-specific properties
 495   # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
 496   # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
 497   # fields.
 498   if ( $custnum ) {
 499
 500     foreach my $contactnum (keys %contact_nums) {
 501
 502       my %hash = ( 'contactnum' => $contactnum,
 503                    'custnum'    => $custnum,
 504                  );
 505       my $error;
 506       if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
 507         $cust_contact->$_($link_hash{$_}) for keys %link_hash;
 508         $error = $cust_contact->replace;
 509       } else {
 510         $cust_contact = new FS::cust_contact { %hash, %link_hash };
 511         $error = $cust_contact->insert;
 512       }
 513       if ( $error ) {
 514         $dbh->rollback if $oldAutoCommit;
 515         return $error;
 516       }
 517     }
 518   }
 519
 520   if ( $prospectnum ) {
 521     my %hash = ( 'contactnum'  => $self->contactnum,
 522                  'prospectnum' => $prospectnum,
 523                );
 524     my $error;
 525     if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
 526       $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
 527       $error = $prospect_contact->replace;
 528     } else {
 529       my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
 530       $error = $prospect_contact->insert;
 531     }
 532     if ( $error ) {
 533       $dbh->rollback if $oldAutoCommit;
 534       return $error;
 535     }
 536   }
 537
 538   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 539                         keys %{ $self->hashref } ) {
 540     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 541     my $phonetypenum = $1;
 542
 543     my %cp = ( 'contactnum'   => $self->contactnum,
 544                'phonetypenum' => $phonetypenum,
 545              );
 546     my $contact_phone = qsearchs('contact_phone', \%cp);
 547
 548     my $pv = $self->get($pf);
 549         $pv =~ s/\s//g;
 550
 551     #if new value is empty, delete old entry
 552     if (!$pv) {
 553       if ($contact_phone) {
 554         $error = $contact_phone->delete;
 555         if ( $error ) {
 556           $dbh->rollback if $oldAutoCommit;
 557           return $error;
 558         }
 559       }
 560       next;
 561     }
 562
 563     $contact_phone ||= new FS::contact_phone \%cp;
 564
 565     my %cpd = _parse_phonestring( $pv );
 566     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 567
 568     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 569
 570     $error = $contact_phone->$method;
 571     if ( $error ) {
 572       $dbh->rollback if $oldAutoCommit;
 573       return $error;
 574     }
 575   }
 576
 577   if ( defined($self->hashref->{'emailaddress'}) ) {
 578
 579     my %contact_emails = ();
 580     foreach my $contact_email ( $self->contact_email ) {
 581       $contact_emails{$contact_email->emailaddress} = '1';
 582     }
 583
 584     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 585
 586       unless ($contact_emails{$email}) {
 587         my $contact_email = new FS::contact_email {
 588           'contactnum'   => $self->contactnum,
 589           'emailaddress' => $email,
 590         };
 591         $error = $contact_email->insert;
 592         if ( $error ) {
 593           $dbh->rollback if $oldAutoCommit;
 594           return $error;
 595         }
 596       }
 597       else { delete($contact_emails{$email}); }
 598
 599     }
 600
 601     foreach my $contact_email ( $self->contact_email ) {
 602       if ($contact_emails{$contact_email->emailaddress}) {
 603         my $error = $contact_email->delete;
 604         if ( $error ) {
 605           $dbh->rollback if $oldAutoCommit;
 606           return $error;
 607         }
 608       }
 609     }
 610
 611   }
 612
 613   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 614     #warn "  queueing fuzzyfiles update\n"
 615     #  if $DEBUG > 1;
 616     $error = $self->queue_fuzzyfiles_update;
 617     if ( $error ) {
 618       $dbh->rollback if $oldAutoCommit;
 619       return "updating fuzzy search cache: $error";
 620     }
 621   }
 622
 623   if ( $cust_contact and (
 624                               (      $cust_contact->selfservice_access eq ''
 625                                   && $link_hash{selfservice_access}
 626                                   && ! length($self->_password)
 627                               )
 628                            || $cust_contact->_resend()
 629                          )
 630     )
 631   {
 632     my $error = $self->send_reset_email( queue=>1 );
 633     if ( $error ) {
 634       $dbh->rollback if $oldAutoCommit;
 635       return $error;
 636     }
 637   }
 638
 639   if ( $self->get('password') ) {
 640     my $error = $self->is_password_allowed($self->get('password'))
 641           ||  $self->change_password($self->get('password'));
 642     if ( $error ) {
 643       $dbh->rollback if $oldAutoCommit;
 644       return $error;
 645     }
 646   }
 647
 648   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 649
 650   '';
 651
 652 }
 653
 654 =item _parse_phonestring PHONENUMBER_STRING
 655
 656 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 657 with keys 'countrycode', 'phonenum' and 'extension'
 658
 659 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 660
 661 =cut
 662
 663 sub _parse_phonestring {
 664   my $value = shift;
 665
 666   my($countrycode, $extension) = ('1', '');
 667
 668   #countrycode
 669   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 670     $countrycode = $1;
 671   } else {
 672     $value =~ s/^\s*1//;
 673   }
 674   #extension
 675   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 676      $extension = $2;
 677   }
 678
 679   ( 'countrycode' => $countrycode,
 680     'phonenum'    => $value,
 681     'extension'   => $extension,
 682   );
 683 }
 684
 685 =item queue_fuzzyfiles_update
 686
 687 Used by insert & replace to update the fuzzy search cache
 688
 689 =cut
 690
 691 use FS::cust_main::Search;
 692 sub queue_fuzzyfiles_update {
 693   my $self = shift;
 694
 695   local $SIG{HUP} = 'IGNORE';
 696   local $SIG{INT} = 'IGNORE';
 697   local $SIG{QUIT} = 'IGNORE';
 698   local $SIG{TERM} = 'IGNORE';
 699   local $SIG{TSTP} = 'IGNORE';
 700   local $SIG{PIPE} = 'IGNORE';
 701
 702   my $oldAutoCommit = $FS::UID::AutoCommit;
 703   local $FS::UID::AutoCommit = 0;
 704   my $dbh = dbh;
 705
 706   foreach my $field ( 'first', 'last' ) {
 707     my $queue = new FS::queue {
 708       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 709     };
 710     my @args = "contact.$field", $self->get($field);
 711     my $error = $queue->insert( @args );
 712     if ( $error ) {
 713       $dbh->rollback if $oldAutoCommit;
 714       return "queueing job (transaction rolled back): $error";
 715     }
 716   }
 717
 718   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 719   '';
 720
 721 }
 722
 723 =item check
 724
 725 Checks all fields to make sure this is a valid contact.  If there is
 726 an error, returns the error, otherwise returns false.  Called by the insert
 727 and replace methods.
 728
 729 =cut
 730
 731 sub check {
 732   my $self = shift;
 733
 734   if ( $self->selfservice_access eq 'R' || $self->selfservice_access eq 'P' ) {
 735     $self->selfservice_access('Y');
 736     $self->_resend('Y');
 737   }
 738
 739   my $error =
 740     $self->ut_numbern('contactnum')
 741     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 742     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 743     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 744     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 745     || $self->ut_namen('last')
 746     || $self->ut_namen('first')
 747     || $self->ut_textn('title')
 748     || $self->ut_textn('comment')
 749     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 750     || $self->ut_textn('_password')
 751     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 752     || $self->ut_enum('disabled', [ '', 'Y' ])
 753   ;
 754   return $error if $error;
 755
 756   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 757
 758   return "One of first name, last name, or title must have a value"
 759     if ! grep $self->$_(), qw( first last title);
 760
 761   $self->SUPER::check;
 762 }
 763
 764 =item line
 765
 766 Returns a formatted string representing this contact, including name, title and
 767 comment.
 768
 769 =cut
 770
 771 sub line {
 772   my $self = shift;
 773   my $data = $self->first. ' '. $self->last;
 774   $data .= ', '. $self->title
 775     if $self->title;
 776   $data .= ' ('. $self->comment. ')'
 777     if $self->comment;
 778   $data;
 779 }
 780
 781 =item firstlast
 782
 783 Returns a formatted string representing this contact, with just the name.
 784
 785 =cut
 786
 787 sub firstlast {
 788   my $self = shift;
 789   $self->first . ' ' . $self->last;
 790 }
 791
 792 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
 793 #
 794 #Returns the name of this contact's class for the specified prospect or
 795 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
 796 #L<FS::contact_class>).
 797 #
 798 #=cut
 799 #
 800 #sub contact_classname {
 801 #  my( $self, $prospect_or_cust ) = @_;
 802 #
 803 #  my $link = '';
 804 #  if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
 805 #    $link = qsearchs('prospect_contact', {
 806 #              'contactnum'  => $self->contactnum,
 807 #              'prospectnum' => $prospect_or_cust->prospectnum,
 808 #            });
 809 #  } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
 810 #    $link = qsearchs('cust_contact', {
 811 #              'contactnum'  => $self->contactnum,
 812 #              'custnum'     => $prospect_or_cust->custnum,
 813 #            });
 814 #  } else {
 815 #    croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
 816 #  }
 817 #
 818 #  my $contact_class = $link->contact_class or return '';
 819 #  $contact_class->classname;
 820 #}
 821
 822 =item by_selfservice_email EMAILADDRESS
 823
 824 Alternate search constructor (class method).  Given an email address, returns
 825 the contact for that address. If that contact doesn't have selfservice access,
 826 or there isn't one, returns the empty string.
 827
 828 =cut
 829
 830 sub by_selfservice_email {
 831   my($class, $email, $case_insensitive) = @_;
 832
 833   my $email_search = "emailaddress = '".$email."'";
 834   $email_search = "LOWER(emailaddress) = LOWER('".$email."')" if $case_insensitive;
 835
 836   my $contact_email = qsearchs({
 837     'table'     => 'contact_email',
 838     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 839     'extra_sql' => "
 840       WHERE $email_search
 841       AND ( contact.disabled IS NULL )
 842       AND EXISTS ( SELECT 1 FROM cust_contact
 843                      WHERE contact.contactnum = cust_contact.contactnum
 844                        AND cust_contact.selfservice_access = 'Y'
 845                  )
 846     ",
 847   }) or return '';
 848
 849   $contact_email->contact;
 850
 851 }
 852
 853 =item by_selfservice_email_custnum EMAILADDRESS, CUSTNUM
 854
 855 Alternate search constructor (class method).  Given an email address and custnum, returns
 856 the contact for that address and custnum. If that contact doesn't have selfservice access,
 857 or there isn't one, returns the empty string.
 858
 859 =cut
 860
 861 sub by_selfservice_email_custnum {
 862   my($class, $email, $custnum) = @_;
 863
 864   my $contact_email = qsearchs({
 865     'table'     => 'contact_email',
 866     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 867     'hashref'   => { 'emailaddress' => $email, },
 868     'extra_sql' => "
 869       AND ( contact.disabled IS NULL )
 870       AND EXISTS ( SELECT 1 FROM cust_contact
 871                      WHERE contact.contactnum = cust_contact.contactnum
 872                        AND cust_contact.selfservice_access = 'Y'
 873                        AND cust_contact.custnum = $custnum
 874                  )
 875     ",
 876   }) or return '';
 877
 878   $contact_email->contact;
 879
 880 }
 881
 882 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 883 # and should maybe be libraried in some way for other password needs
 884
 885 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 886
 887 sub authenticate_password {
 888   my($self, $check_password) = @_;
 889
 890   if ( $self->_password_encoding eq 'bcrypt' ) {
 891
 892     my( $cost, $salt, $hash ) = split(',', $self->_password);
 893
 894     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 895                                                cost    => $cost,
 896                                                salt    => de_base64($salt),
 897                                              },
 898                                              $check_password
 899                                            )
 900                               );
 901
 902     $hash eq $check_hash;
 903
 904   } else {
 905
 906     return 0 if $self->_password eq '';
 907
 908     $self->_password eq $check_password;
 909
 910   }
 911
 912 }
 913
 914 =item change_password NEW_PASSWORD
 915
 916 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 917 not check password policy rules (see C<is_password_allowed>) and will return
 918 an error only if editing the record fails for some reason.
 919
 920 If NEW_PASSWORD is the same as the existing password, this does nothing.
 921
 922 =cut
 923
 924 sub change_password {
 925   my($self, $new_password) = @_;
 926
 927   # do nothing if the password is unchanged
 928   return if $self->authenticate_password($new_password);
 929
 930   $self->change_password_fields( $new_password );
 931
 932   $self->replace;
 933
 934 }
 935
 936 sub change_password_fields {
 937   my($self, $new_password) = @_;
 938
 939   $self->_password_encoding('bcrypt');
 940
 941   my $cost = 8;
 942
 943   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 944
 945   my $hash = bcrypt_hash( { key_nul => 1,
 946                             cost    => $cost,
 947                             salt    => $salt,
 948                           },
 949                           $new_password,
 950                         );
 951
 952   $self->_password(
 953     join(',', $cost, en_base64($salt), en_base64($hash) )
 954   );
 955
 956 }
 957
 958 # end of false laziness w/FS/FS/Auth/internal.pm
 959
 960
 961 #false laziness w/ClientAPI/MyAccount/reset_passwd
 962 use Digest::SHA qw(sha512_hex);
 963 use FS::Conf;
 964 use FS::ClientAPI_SessionCache;
 965 sub send_reset_email {
 966   my( $self, %opt ) = @_;
 967
 968   my @contact_email = $self->contact_email or return '';
 969
 970   my $reset_session = {
 971     'contactnum' => $self->contactnum,
 972     'svcnum'     => $opt{'svcnum'},
 973   };
 974
 975
 976   my $conf = new FS::Conf;
 977   my $timeout =
 978     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 979
 980   my $reset_session_id;
 981   do {
 982     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 983   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 984     #just in case
 985
 986   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 987
 988   #email it
 989
 990   my $cust_main = '';
 991   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 992   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 993
 994   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 995   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 996   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 997   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 998   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 999   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
1000   my %msg_template = (
1001     'to'            => join(',', map $_->emailaddress, @contact_email ),
1002     'cust_main'     => $cust_main,
1003     'object'        => $self,
1004     'substitutions' => { 'session_id' => $reset_session_id }
1005   );
1006
1007   if ( $opt{'queue'} ) { #or should queueing just be the default?
1008
1009     my $cust_msg = $msg_template->prepare( %msg_template );
1010     my $error = $cust_msg->insert;
1011     return $error if $error;
1012     my $queue = new FS::queue {
1013       'job'     => 'FS::cust_msg::process_send',
1014       'custnum' => $cust_main ? $cust_main->custnum : '',
1015     };
1016     $queue->insert( $cust_msg->custmsgnum );
1017
1018   } else {
1019
1020     $msg_template->send( %msg_template );
1021
1022   }
1023
1024 }
1025
1026 use vars qw( $myaccount_cache );
1027 sub myaccount_cache {
1028   #my $class = shift;
1029   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
1030                          'namespace' => 'FS::ClientAPI::MyAccount',
1031                        } );
1032 }
1033
1034 =item cgi_contact_fields
1035
1036 Returns a list reference containing the set of contact fields used in the web
1037 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
1038 and locationnum, as well as password fields, but including fields for
1039 contact_email and contact_phone records.)
1040
1041 =cut
1042
1043 sub cgi_contact_fields {
1044   #my $class = shift;
1045
1046   my @contact_fields = qw(
1047     classnum first last title comment emailaddress selfservice_access
1048     invoice_dest message_dest password
1049   );
1050
1051   push @contact_fields, 'phonetypenum'. $_->phonetypenum
1052     foreach qsearch({table=>'phone_type', order_by=>'weight'});
1053
1054   \@contact_fields;
1055
1056 }
1057
1058 use FS::upgrade_journal;
1059 sub _upgrade_data { #class method
1060   my ($class, %opts) = @_;
1061
1062   # before anything else, migrate contact.custnum to cust_contact records
1063   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
1064
1065     local($skip_fuzzyfiles) = 1;
1066
1067     foreach my $contact (qsearch('contact', {})) {
1068       my $error = $contact->replace;
1069       die $error if $error;
1070     }
1071
1072     FS::upgrade_journal->set_done('contact_invoice_dest');
1073   }
1074
1075
1076   # always migrate cust_main_invoice records over
1077   local $FS::cust_main::import = 1; # override require_phone and such
1078   my $search = FS::Cursor->new('cust_main_invoice', {});
1079   my %custnum_dest;
1080   while (my $cust_main_invoice = $search->fetch) {
1081     my $custnum = $cust_main_invoice->custnum;
1082     my $dest = $cust_main_invoice->dest;
1083     my $cust_main = $cust_main_invoice->cust_main;
1084
1085     if ( $dest =~ /^\d+$/ ) {
1086       my $svc_acct = FS::svc_acct->by_key($dest);
1087       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1088         if !$svc_acct;
1089       $dest = $svc_acct->email;
1090     }
1091     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1092
1093     my $error = $cust_main_invoice->delete;
1094     if ( $error ) {
1095       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1096     }
1097   }
1098
1099   foreach my $custnum (keys %custnum_dest) {
1100     my $dests = $custnum_dest{$custnum};
1101     my $cust_main = FS::cust_main->by_key($custnum);
1102     my $error = $cust_main->replace( invoicing_list => $dests );
1103     if ( $error ) {
1104       die "custnum $custnum, creating contact: $error\n";
1105     }
1106   }
1107
1108 }
1109
1110 =back
1111
1112 =head1 BUGS
1113
1114 =head1 SEE ALSO
1115
1116 L<FS::Record>, schema.html from the base documentation.
1117
1118 =cut
1119
1120 1;