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 Scalar::Util qw( blessed );
   8 use FS::Record qw( qsearch qsearchs dbh );
   9 use FS::prospect_main;
  10 use FS::cust_main;
  11 use FS::contact_class;
  12 use FS::cust_location;
  13 use FS::contact_phone;
  14 use FS::contact_email;
  15 use FS::queue;
  16 use FS::cust_pkg;
  17 use FS::phone_type; #for cgi_contact_fields
  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
  95 =back
  96
  97 =head1 METHODS
  98
  99 =over 4
 100
 101 =item new HASHREF
 102
 103 Creates a new contact.  To add the contact to the database, see L<"insert">.
 104
 105 Note that this stores the hash reference, not a distinct copy of the hash it
 106 points to.  You can ask the object for a copy with the I<hash> method.
 107
 108 =cut
 109
 110 sub table { 'contact'; }
 111
 112 =item insert
 113
 114 Adds this record to the database.  If there is an error, returns the error,
 115 otherwise returns false.
 116
 117 =cut
 118
 119 sub insert {
 120   my $self = shift;
 121
 122   local $SIG{INT} = 'IGNORE';
 123   local $SIG{QUIT} = 'IGNORE';
 124   local $SIG{TERM} = 'IGNORE';
 125   local $SIG{TSTP} = 'IGNORE';
 126   local $SIG{PIPE} = 'IGNORE';
 127
 128   my $oldAutoCommit = $FS::UID::AutoCommit;
 129   local $FS::UID::AutoCommit = 0;
 130   my $dbh = dbh;
 131
 132   my $error = $self->SUPER::insert;
 133   $error ||= $self->insert_password_history;
 134
 135   if ( $error ) {
 136     $dbh->rollback if $oldAutoCommit;
 137     return $error;
 138   }
 139
 140   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 141                         keys %{ $self->hashref } ) {
 142     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 143     my $phonetypenum = $1;
 144
 145     my $contact_phone = new FS::contact_phone {
 146       'contactnum' => $self->contactnum,
 147       'phonetypenum' => $phonetypenum,
 148       _parse_phonestring( $self->get($pf) ),
 149     };
 150     $error = $contact_phone->insert;
 151     if ( $error ) {
 152       $dbh->rollback if $oldAutoCommit;
 153       return $error;
 154     }
 155   }
 156
 157   if ( $self->get('emailaddress') =~ /\S/ ) {
 158
 159     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 160
 161       my $contact_email = new FS::contact_email {
 162         'contactnum'   => $self->contactnum,
 163         'emailaddress' => $email,
 164       };
 165       $error = $contact_email->insert;
 166       if ( $error ) {
 167         $dbh->rollback if $oldAutoCommit;
 168         return $error;
 169       }
 170
 171     }
 172
 173   }
 174
 175   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 176     #warn "  queueing fuzzyfiles update\n"
 177     #  if $DEBUG > 1;
 178     $error = $self->queue_fuzzyfiles_update;
 179     if ( $error ) {
 180       $dbh->rollback if $oldAutoCommit;
 181       return "updating fuzzy search cache: $error";
 182     }
 183   }
 184
 185   if ( $self->selfservice_access && ! length($self->_password) ) {
 186     my $error = $self->send_reset_email( queue=>1 );
 187     if ( $error ) {
 188       $dbh->rollback if $oldAutoCommit;
 189       return $error;
 190     }
 191   }
 192
 193   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 194
 195   '';
 196
 197 }
 198
 199 =item delete
 200
 201 Delete this record from the database.
 202
 203 =cut
 204
 205 sub delete {
 206   my $self = shift;
 207
 208   local $SIG{HUP} = 'IGNORE';
 209   local $SIG{INT} = 'IGNORE';
 210   local $SIG{QUIT} = 'IGNORE';
 211   local $SIG{TERM} = 'IGNORE';
 212   local $SIG{TSTP} = 'IGNORE';
 213   local $SIG{PIPE} = 'IGNORE';
 214
 215   my $oldAutoCommit = $FS::UID::AutoCommit;
 216   local $FS::UID::AutoCommit = 0;
 217   my $dbh = dbh;
 218
 219   foreach my $cust_pkg ( $self->cust_pkg ) {
 220     $cust_pkg->contactnum('');
 221     my $error = $cust_pkg->replace;
 222     if ( $error ) {
 223       $dbh->rollback if $oldAutoCommit;
 224       return $error;
 225     }
 226   }
 227
 228   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 229     my $error = $object->delete;
 230     if ( $error ) {
 231       $dbh->rollback if $oldAutoCommit;
 232       return $error;
 233     }
 234   }
 235
 236   my $error = $self->delete_password_history
 237            || $self->SUPER::delete;
 238   if ( $error ) {
 239     $dbh->rollback if $oldAutoCommit;
 240     return $error;
 241   }
 242
 243   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 244   '';
 245
 246 }
 247
 248 =item replace OLD_RECORD
 249
 250 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 251 returns the error, otherwise returns false.
 252
 253 =cut
 254
 255 sub replace {
 256   my $self = shift;
 257
 258   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 259               ? shift
 260               : $self->replace_old;
 261
 262   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 263
 264   local $SIG{INT} = 'IGNORE';
 265   local $SIG{QUIT} = 'IGNORE';
 266   local $SIG{TERM} = 'IGNORE';
 267   local $SIG{TSTP} = 'IGNORE';
 268   local $SIG{PIPE} = 'IGNORE';
 269
 270   my $oldAutoCommit = $FS::UID::AutoCommit;
 271   local $FS::UID::AutoCommit = 0;
 272   my $dbh = dbh;
 273
 274   my $error = $self->SUPER::replace($old);
 275   if ( $old->_password ne $self->_password ) {
 276     $error ||= $self->insert_password_history;
 277   }
 278   if ( $error ) {
 279     $dbh->rollback if $oldAutoCommit;
 280     return $error;
 281   }
 282
 283   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 284                         keys %{ $self->hashref } ) {
 285     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 286     my $phonetypenum = $1;
 287
 288     my %cp = ( 'contactnum'   => $self->contactnum,
 289                'phonetypenum' => $phonetypenum,
 290              );
 291     my $contact_phone = qsearchs('contact_phone', \%cp);
 292
 293     my $pv = $self->get($pf);
 294         $pv =~ s/\s//g;
 295
 296     #if new value is empty, delete old entry
 297     if (!$pv) {
 298       if ($contact_phone) {
 299         $error = $contact_phone->delete;
 300         if ( $error ) {
 301           $dbh->rollback if $oldAutoCommit;
 302           return $error;
 303         }
 304       }
 305       next;
 306     }
 307
 308     $contact_phone ||= new FS::contact_phone \%cp;
 309
 310     my %cpd = _parse_phonestring( $pv );
 311     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 312
 313     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 314
 315     $error = $contact_phone->$method;
 316     if ( $error ) {
 317       $dbh->rollback if $oldAutoCommit;
 318       return $error;
 319     }
 320   }
 321
 322   if ( defined($self->hashref->{'emailaddress'}) ) {
 323
 324     #ineffecient but whatever, how many email addresses can there be?
 325
 326     foreach my $contact_email ( $self->contact_email ) {
 327       my $error = $contact_email->delete;
 328       if ( $error ) {
 329         $dbh->rollback if $oldAutoCommit;
 330         return $error;
 331       }
 332     }
 333
 334     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 335
 336       my $contact_email = new FS::contact_email {
 337         'contactnum'   => $self->contactnum,
 338         'emailaddress' => $email,
 339       };
 340       $error = $contact_email->insert;
 341       if ( $error ) {
 342         $dbh->rollback if $oldAutoCommit;
 343         return $error;
 344       }
 345
 346     }
 347
 348   }
 349
 350   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 351     #warn "  queueing fuzzyfiles update\n"
 352     #  if $DEBUG > 1;
 353     $error = $self->queue_fuzzyfiles_update;
 354     if ( $error ) {
 355       $dbh->rollback if $oldAutoCommit;
 356       return "updating fuzzy search cache: $error";
 357     }
 358   }
 359
 360   if (    ( $old->selfservice_access eq '' && $self->selfservice_access
 361               && ! $self->_password
 362           )
 363        || $self->_resend()
 364      )
 365   {
 366     my $error = $self->send_reset_email( queue=>1 );
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371   }
 372
 373   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 374
 375   '';
 376
 377 }
 378
 379 =item _parse_phonestring PHONENUMBER_STRING
 380
 381 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 382 with keys 'countrycode', 'phonenum' and 'extension'
 383
 384 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 385
 386 =cut
 387
 388 sub _parse_phonestring {
 389   my $value = shift;
 390
 391   my($countrycode, $extension) = ('1', '');
 392
 393   #countrycode
 394   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 395     $countrycode = $1;
 396   } else {
 397     $value =~ s/^\s*1//;
 398   }
 399   #extension
 400   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 401      $extension = $2;
 402   }
 403
 404   ( 'countrycode' => $countrycode,
 405     'phonenum'    => $value,
 406     'extension'   => $extension,
 407   );
 408 }
 409
 410 =item queue_fuzzyfiles_update
 411
 412 Used by insert & replace to update the fuzzy search cache
 413
 414 =cut
 415
 416 use FS::cust_main::Search;
 417 sub queue_fuzzyfiles_update {
 418   my $self = shift;
 419
 420   local $SIG{HUP} = 'IGNORE';
 421   local $SIG{INT} = 'IGNORE';
 422   local $SIG{QUIT} = 'IGNORE';
 423   local $SIG{TERM} = 'IGNORE';
 424   local $SIG{TSTP} = 'IGNORE';
 425   local $SIG{PIPE} = 'IGNORE';
 426
 427   my $oldAutoCommit = $FS::UID::AutoCommit;
 428   local $FS::UID::AutoCommit = 0;
 429   my $dbh = dbh;
 430
 431   foreach my $field ( 'first', 'last' ) {
 432     my $queue = new FS::queue {
 433       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 434     };
 435     my @args = "contact.$field", $self->get($field);
 436     my $error = $queue->insert( @args );
 437     if ( $error ) {
 438       $dbh->rollback if $oldAutoCommit;
 439       return "queueing job (transaction rolled back): $error";
 440     }
 441   }
 442
 443   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 444   '';
 445
 446 }
 447
 448 =item check
 449
 450 Checks all fields to make sure this is a valid contact.  If there is
 451 an error, returns the error, otherwise returns false.  Called by the insert
 452 and replace methods.
 453
 454 =cut
 455
 456 sub check {
 457   my $self = shift;
 458
 459   if ( $self->selfservice_access eq 'R' ) {
 460     $self->selfservice_access('Y');
 461     $self->_resend('Y');
 462   }
 463
 464   my $error =
 465     $self->ut_numbern('contactnum')
 466     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 467     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 468     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 469     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 470     || $self->ut_namen('last')
 471     || $self->ut_namen('first')
 472     || $self->ut_textn('title')
 473     || $self->ut_textn('comment')
 474     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 475     || $self->ut_textn('_password')
 476     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 477     || $self->ut_enum('disabled', [ '', 'Y' ])
 478   ;
 479   return $error if $error;
 480
 481   return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
 482   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 483
 484   return "One of first name, last name, or title must have a value"
 485     if ! grep $self->$_(), qw( first last title);
 486
 487   $self->SUPER::check;
 488 }
 489
 490 =item line
 491
 492 Returns a formatted string representing this contact, including name, title and
 493 comment.
 494
 495 =cut
 496
 497 sub line {
 498   my $self = shift;
 499   my $data = $self->first. ' '. $self->last;
 500   $data .= ', '. $self->title
 501     if $self->title;
 502   $data .= ' ('. $self->comment. ')'
 503     if $self->comment;
 504   $data;
 505 }
 506
 507 sub cust_location {
 508   my $self = shift;
 509   return '' unless $self->locationnum;
 510   qsearchs('cust_location', { 'locationnum' => $self->locationnum } );
 511 }
 512
 513 sub contact_class {
 514   my $self = shift;
 515   return '' unless $self->classnum;
 516   qsearchs('contact_class', { 'classnum' => $self->classnum } );
 517 }
 518
 519 =item firstlast
 520
 521 Returns a formatted string representing this contact, with just the name.
 522
 523 =cut
 524
 525 sub firstlast {
 526   my $self = shift;
 527   $self->first . ' ' . $self->last;
 528 }
 529
 530 =item contact_classname
 531
 532 Returns the name of this contact's class (see L<FS::contact_class>).
 533
 534 =cut
 535
 536 sub contact_classname {
 537   my $self = shift;
 538   my $contact_class = $self->contact_class or return '';
 539   $contact_class->classname;
 540 }
 541
 542 sub contact_phone {
 543   my $self = shift;
 544   qsearch('contact_phone', { 'contactnum' => $self->contactnum } );
 545 }
 546
 547 sub contact_email {
 548   my $self = shift;
 549   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 550 }
 551
 552 sub cust_main {
 553   my $self = shift;
 554   qsearchs('cust_main', { 'custnum' => $self->custnum  } );
 555 }
 556
 557 sub cust_pkg {
 558   my $self = shift;
 559   qsearch('cust_pkg', { 'contactnum' => $self->contactnum  } );
 560 }
 561
 562 =item by_selfservice_email EMAILADDRESS
 563
 564 Alternate search constructor (class method).  Given an email address,
 565 returns the contact for that address, or the empty string if no contact
 566 has that email address.
 567
 568 =cut
 569
 570 sub by_selfservice_email {
 571   my($class, $email) = @_;
 572
 573   my $contact_email = qsearchs({
 574     'table'     => 'contact_email',
 575     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 576     'hashref'   => { 'emailaddress' => $email, },
 577     'extra_sql' => " AND selfservice_access = 'Y' ".
 578                    " AND ( disabled IS NULL OR disabled = '' )",
 579   }) or return '';
 580
 581   $contact_email->contact;
 582
 583 }
 584
 585 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 586 # and should maybe be libraried in some way for other password needs
 587
 588 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 589
 590 sub authenticate_password {
 591   my($self, $check_password) = @_;
 592
 593   if ( $self->_password_encoding eq 'bcrypt' ) {
 594
 595     my( $cost, $salt, $hash ) = split(',', $self->_password);
 596
 597     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 598                                                cost    => $cost,
 599                                                salt    => de_base64($salt),
 600                                              },
 601                                              $check_password
 602                                            )
 603                               );
 604
 605     $hash eq $check_hash;
 606
 607   } else {
 608
 609     return 0 if $self->_password eq '';
 610
 611     $self->_password eq $check_password;
 612
 613   }
 614
 615 }
 616
 617 =item change_password NEW_PASSWORD
 618
 619 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 620 not check password policy rules (see C<is_password_allowed>) and will return
 621 an error only if editing the record fails for some reason.
 622
 623 If NEW_PASSWORD is the same as the existing password, this does nothing.
 624
 625 =cut
 626
 627 sub change_password {
 628   my($self, $new_password) = @_;
 629
 630   # do nothing if the password is unchanged
 631   return if $self->authenticate_password($new_password);
 632
 633   $self->change_password_fields( $new_password );
 634
 635   $self->replace;
 636
 637 }
 638
 639 sub change_password_fields {
 640   my($self, $new_password) = @_;
 641
 642   $self->_password_encoding('bcrypt');
 643
 644   my $cost = 8;
 645
 646   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 647
 648   my $hash = bcrypt_hash( { key_nul => 1,
 649                             cost    => $cost,
 650                             salt    => $salt,
 651                           },
 652                           $new_password,
 653                         );
 654
 655   $self->_password(
 656     join(',', $cost, en_base64($salt), en_base64($hash) )
 657   );
 658
 659 }
 660
 661 # end of false laziness w/FS/FS/Auth/internal.pm
 662
 663
 664 #false laziness w/ClientAPI/MyAccount/reset_passwd
 665 use Digest::SHA qw(sha512_hex);
 666 use FS::Conf;
 667 use FS::ClientAPI_SessionCache;
 668 sub send_reset_email {
 669   my( $self, %opt ) = @_;
 670
 671   my @contact_email = $self->contact_email or return '';
 672
 673   my $reset_session = {
 674     'contactnum' => $self->contactnum,
 675     'svcnum'     => $opt{'svcnum'},
 676   };
 677
 678
 679   my $conf = new FS::Conf;
 680   my $timeout =
 681     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 682
 683   my $reset_session_id;
 684   do {
 685     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 686   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 687     #just in case
 688
 689   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 690
 691   #email it
 692
 693   my $conf = new FS::Conf;
 694
 695   my $cust_main = $self->cust_main
 696     or die "no customer"; #reset a password for a prospect contact?  someday
 697
 698   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $cust_main->agentnum);
 699   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 700   return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
 701   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 702   my %msg_template = (
 703     'to'            => join(',', map $_->emailaddress, @contact_email ),
 704     'cust_main'     => $cust_main,
 705     'object'        => $self,
 706     'substitutions' => { 'session_id' => $reset_session_id }
 707   );
 708
 709   if ( $opt{'queue'} ) { #or should queueing just be the default?
 710
 711     my $queue = new FS::queue {
 712       'job'     => 'FS::Misc::process_send_email',
 713       'custnum' => $cust_main->custnum,
 714     };
 715     $queue->insert( $msg_template->prepare( %msg_template ) );
 716
 717   } else {
 718
 719     $msg_template->send( %msg_template );
 720
 721   }
 722
 723 }
 724
 725 use vars qw( $myaccount_cache );
 726 sub myaccount_cache {
 727   #my $class = shift;
 728   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 729                          'namespace' => 'FS::ClientAPI::MyAccount',
 730                        } );
 731 }
 732
 733 =item cgi_contact_fields
 734
 735 Returns a list reference containing the set of contact fields used in the web
 736 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 737 and locationnum, as well as password fields, but including fields for
 738 contact_email and contact_phone records.)
 739
 740 =cut
 741
 742 sub cgi_contact_fields {
 743   #my $class = shift;
 744
 745   my @contact_fields = qw(
 746     classnum first last title comment emailaddress selfservice_access
 747   );
 748
 749   push @contact_fields, 'phonetypenum'. $_->phonetypenum
 750     foreach qsearch({table=>'phone_type', order_by=>'weight'});
 751
 752   \@contact_fields;
 753
 754 }
 755
 756 use FS::phone_type;
 757
 758 =back
 759
 760 =head1 BUGS
 761
 762 =head1 SEE ALSO
 763
 764 L<FS::Record>, schema.html from the base documentation.
 765
 766 =cut
 767
 768 1;
 769