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