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 #autoloaded by FK in 4.x, but not during the upgrade
 823 sub contact_email {
 824   my $self = shift;
 825   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 826 }
 827
 828 =item by_selfservice_email EMAILADDRESS
 829
 830 Alternate search constructor (class method).  Given an email address, returns
 831 the contact for that address. If that contact doesn't have selfservice access,
 832 or there isn't one, returns the empty string.
 833
 834 =cut
 835
 836 sub by_selfservice_email {
 837   my($class, $email) = @_;
 838
 839   my $contact_email = qsearchs({
 840     'table'     => 'contact_email',
 841     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 842     'hashref'   => { 'emailaddress' => $email, },
 843     'extra_sql' => "
 844       AND ( contact.disabled IS NULL )
 845       AND EXISTS ( SELECT 1 FROM cust_contact
 846                      WHERE contact.contactnum = cust_contact.contactnum
 847                        AND cust_contact.selfservice_access = 'Y'
 848                  )
 849     ",
 850   }) or return '';
 851
 852   $contact_email->contact;
 853
 854 }
 855
 856 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 857 # and should maybe be libraried in some way for other password needs
 858
 859 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 860
 861 sub authenticate_password {
 862   my($self, $check_password) = @_;
 863
 864   if ( $self->_password_encoding eq 'bcrypt' ) {
 865
 866     my( $cost, $salt, $hash ) = split(',', $self->_password);
 867
 868     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 869                                                cost    => $cost,
 870                                                salt    => de_base64($salt),
 871                                              },
 872                                              $check_password
 873                                            )
 874                               );
 875
 876     $hash eq $check_hash;
 877
 878   } else {
 879
 880     return 0 if $self->_password eq '';
 881
 882     $self->_password eq $check_password;
 883
 884   }
 885
 886 }
 887
 888 =item change_password NEW_PASSWORD
 889
 890 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 891 not check password policy rules (see C<is_password_allowed>) and will return
 892 an error only if editing the record fails for some reason.
 893
 894 If NEW_PASSWORD is the same as the existing password, this does nothing.
 895
 896 =cut
 897
 898 sub change_password {
 899   my($self, $new_password) = @_;
 900
 901   # do nothing if the password is unchanged
 902   return if $self->authenticate_password($new_password);
 903
 904   $self->change_password_fields( $new_password );
 905
 906   $self->replace;
 907
 908 }
 909
 910 sub change_password_fields {
 911   my($self, $new_password) = @_;
 912
 913   $self->_password_encoding('bcrypt');
 914
 915   my $cost = 8;
 916
 917   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 918
 919   my $hash = bcrypt_hash( { key_nul => 1,
 920                             cost    => $cost,
 921                             salt    => $salt,
 922                           },
 923                           $new_password,
 924                         );
 925
 926   $self->_password(
 927     join(',', $cost, en_base64($salt), en_base64($hash) )
 928   );
 929
 930 }
 931
 932 # end of false laziness w/FS/FS/Auth/internal.pm
 933
 934
 935 #false laziness w/ClientAPI/MyAccount/reset_passwd
 936 use Digest::SHA qw(sha512_hex);
 937 use FS::Conf;
 938 use FS::ClientAPI_SessionCache;
 939 sub send_reset_email {
 940   my( $self, %opt ) = @_;
 941
 942   my @contact_email = $self->contact_email or return '';
 943
 944   my $reset_session = {
 945     'contactnum' => $self->contactnum,
 946     'svcnum'     => $opt{'svcnum'},
 947   };
 948
 949
 950   my $conf = new FS::Conf;
 951   my $timeout =
 952     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 953
 954   my $reset_session_id;
 955   do {
 956     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 957   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 958     #just in case
 959
 960   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 961
 962   #email it
 963
 964   my $cust_main = '';
 965   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 966   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 967
 968   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 969   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 970   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 971   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 972   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 973   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 974   my %msg_template = (
 975     'to'            => join(',', map $_->emailaddress, @contact_email ),
 976     'cust_main'     => $cust_main,
 977     'object'        => $self,
 978     'substitutions' => { 'session_id' => $reset_session_id }
 979   );
 980
 981   if ( $opt{'queue'} ) { #or should queueing just be the default?
 982
 983     my $cust_msg = $msg_template->prepare( %msg_template );
 984     my $error = $cust_msg->insert;
 985     return $error if $error;
 986     my $queue = new FS::queue {
 987       'job'     => 'FS::cust_msg::process_send',
 988       'custnum' => $cust_main ? $cust_main->custnum : '',
 989     };
 990     $queue->insert( $cust_msg->custmsgnum );
 991
 992   } else {
 993
 994     $msg_template->send( %msg_template );
 995
 996   }
 997
 998 }
 999
1000 use vars qw( $myaccount_cache );
1001 sub myaccount_cache {
1002   #my $class = shift;
1003   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
1004                          'namespace' => 'FS::ClientAPI::MyAccount',
1005                        } );
1006 }
1007
1008 =item cgi_contact_fields
1009
1010 Returns a list reference containing the set of contact fields used in the web
1011 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
1012 and locationnum, as well as password fields, but including fields for
1013 contact_email and contact_phone records.)
1014
1015 =cut
1016
1017 sub cgi_contact_fields {
1018   #my $class = shift;
1019
1020   my @contact_fields = qw(
1021     classnum first last title comment emailaddress selfservice_access
1022     invoice_dest message_dest password
1023   );
1024
1025   push @contact_fields, 'phonetypenum'. $_->phonetypenum
1026     foreach qsearch({table=>'phone_type', order_by=>'weight'});
1027
1028   \@contact_fields;
1029
1030 }
1031
1032 use FS::upgrade_journal;
1033 sub _upgrade_data { #class method
1034   my ($class, %opts) = @_;
1035
1036   # before anything else, migrate contact.custnum to cust_contact records
1037   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
1038
1039     local($skip_fuzzyfiles) = 1;
1040
1041     foreach my $contact (qsearch('contact', {})) {
1042       my $error = $contact->replace;
1043       die $error if $error;
1044     }
1045
1046     FS::upgrade_journal->set_done('contact_invoice_dest');
1047   }
1048
1049
1050   # always migrate cust_main_invoice records over
1051   local $FS::cust_main::import = 1; # override require_phone and such
1052   my $search = FS::Cursor->new('cust_main_invoice', {});
1053   my %custnum_dest;
1054   while (my $cust_main_invoice = $search->fetch) {
1055     my $custnum = $cust_main_invoice->custnum;
1056     my $dest = $cust_main_invoice->dest;
1057     my $cust_main = $cust_main_invoice->cust_main;
1058
1059     if ( $dest =~ /^\d+$/ ) {
1060       my $svc_acct = FS::svc_acct->by_key($dest);
1061       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1062         if !$svc_acct;
1063       $dest = $svc_acct->email;
1064     }
1065     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1066
1067     my $error = $cust_main_invoice->delete;
1068     if ( $error ) {
1069       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1070     }
1071   }
1072
1073   foreach my $custnum (keys %custnum_dest) {
1074     my $dests = $custnum_dest{$custnum};
1075     my $cust_main = FS::cust_main->by_key($custnum);
1076     my $error = $cust_main->replace( invoicing_list => $dests );
1077     if ( $error ) {
1078       die "custnum $custnum, creating contact: $error\n";
1079     }
1080   }
1081
1082 }
1083
1084 =back
1085
1086 =head1 BUGS
1087
1088 =head1 SEE ALSO
1089
1090 L<FS::Record>, schema.html from the base documentation.
1091
1092 =cut
1093
1094 1;