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   if ( $self->get('password') ) {
 374     my $error = $self->is_password_allowed($self->get('password'))
 375           ||  $self->change_password($self->get('password'));
 376     if ( $error ) {
 377       $dbh->rollback if $oldAutoCommit;
 378       return $error;
 379     }
 380   }
 381
 382   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 383
 384   '';
 385
 386 }
 387
 388 =item _parse_phonestring PHONENUMBER_STRING
 389
 390 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 391 with keys 'countrycode', 'phonenum' and 'extension'
 392
 393 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 394
 395 =cut
 396
 397 sub _parse_phonestring {
 398   my $value = shift;
 399
 400   my($countrycode, $extension) = ('1', '');
 401
 402   #countrycode
 403   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 404     $countrycode = $1;
 405   } else {
 406     $value =~ s/^\s*1//;
 407   }
 408   #extension
 409   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 410      $extension = $2;
 411   }
 412
 413   ( 'countrycode' => $countrycode,
 414     'phonenum'    => $value,
 415     'extension'   => $extension,
 416   );
 417 }
 418
 419 =item queue_fuzzyfiles_update
 420
 421 Used by insert & replace to update the fuzzy search cache
 422
 423 =cut
 424
 425 use FS::cust_main::Search;
 426 sub queue_fuzzyfiles_update {
 427   my $self = shift;
 428
 429   local $SIG{HUP} = 'IGNORE';
 430   local $SIG{INT} = 'IGNORE';
 431   local $SIG{QUIT} = 'IGNORE';
 432   local $SIG{TERM} = 'IGNORE';
 433   local $SIG{TSTP} = 'IGNORE';
 434   local $SIG{PIPE} = 'IGNORE';
 435
 436   my $oldAutoCommit = $FS::UID::AutoCommit;
 437   local $FS::UID::AutoCommit = 0;
 438   my $dbh = dbh;
 439
 440   foreach my $field ( 'first', 'last' ) {
 441     my $queue = new FS::queue {
 442       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 443     };
 444     my @args = "contact.$field", $self->get($field);
 445     my $error = $queue->insert( @args );
 446     if ( $error ) {
 447       $dbh->rollback if $oldAutoCommit;
 448       return "queueing job (transaction rolled back): $error";
 449     }
 450   }
 451
 452   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 453   '';
 454
 455 }
 456
 457 =item check
 458
 459 Checks all fields to make sure this is a valid contact.  If there is
 460 an error, returns the error, otherwise returns false.  Called by the insert
 461 and replace methods.
 462
 463 =cut
 464
 465 sub check {
 466   my $self = shift;
 467
 468   if ( $self->selfservice_access eq 'R' || $self->selfservice_access eq 'E' || $self->selfservice_access eq 'P' ) {
 469     $self->selfservice_access('Y');
 470     $self->_resend('Y');
 471   }
 472
 473   my $error =
 474     $self->ut_numbern('contactnum')
 475     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 476     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 477     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 478     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 479     || $self->ut_namen('last')
 480     || $self->ut_namen('first')
 481     || $self->ut_textn('title')
 482     || $self->ut_textn('comment')
 483     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 484     || $self->ut_textn('_password')
 485     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 486     || $self->ut_enum('disabled', [ '', 'Y' ])
 487   ;
 488   return $error if $error;
 489
 490   return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
 491   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 492
 493   return "One of first name, last name, or title must have a value"
 494     if ! grep $self->$_(), qw( first last title);
 495
 496   $self->SUPER::check;
 497 }
 498
 499 =item line
 500
 501 Returns a formatted string representing this contact, including name, title and
 502 comment.
 503
 504 =cut
 505
 506 sub line {
 507   my $self = shift;
 508   my $data = $self->first. ' '. $self->last;
 509   $data .= ', '. $self->title
 510     if $self->title;
 511   $data .= ' ('. $self->comment. ')'
 512     if $self->comment;
 513   $data;
 514 }
 515
 516 sub cust_location {
 517   my $self = shift;
 518   return '' unless $self->locationnum;
 519   qsearchs('cust_location', { 'locationnum' => $self->locationnum } );
 520 }
 521
 522 sub contact_class {
 523   my $self = shift;
 524   return '' unless $self->classnum;
 525   qsearchs('contact_class', { 'classnum' => $self->classnum } );
 526 }
 527
 528 =item firstlast
 529
 530 Returns a formatted string representing this contact, with just the name.
 531
 532 =cut
 533
 534 sub firstlast {
 535   my $self = shift;
 536   $self->first . ' ' . $self->last;
 537 }
 538
 539 =item contact_classname
 540
 541 Returns the name of this contact's class (see L<FS::contact_class>).
 542
 543 =cut
 544
 545 sub contact_classname {
 546   my $self = shift;
 547   my $contact_class = $self->contact_class or return '';
 548   $contact_class->classname;
 549 }
 550
 551 sub contact_phone {
 552   my $self = shift;
 553   qsearch('contact_phone', { 'contactnum' => $self->contactnum } );
 554 }
 555
 556 sub contact_email {
 557   my $self = shift;
 558   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 559 }
 560
 561 sub cust_main {
 562   my $self = shift;
 563   qsearchs('cust_main', { 'custnum' => $self->custnum  } );
 564 }
 565
 566 sub cust_pkg {
 567   my $self = shift;
 568   qsearch('cust_pkg', { 'contactnum' => $self->contactnum  } );
 569 }
 570
 571 =item by_selfservice_email EMAILADDRESS
 572
 573 Alternate search constructor (class method).  Given an email address,
 574 returns the contact for that address, or the empty string if no contact
 575 has that email address.
 576
 577 =cut
 578
 579 sub by_selfservice_email {
 580   my($class, $email) = @_;
 581
 582   my $contact_email = qsearchs({
 583     'table'     => 'contact_email',
 584     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 585     'hashref'   => { 'emailaddress' => $email, },
 586     'extra_sql' => " AND selfservice_access = 'Y' ".
 587                    " AND ( disabled IS NULL OR disabled = '' )",
 588   }) or return '';
 589
 590   $contact_email->contact;
 591
 592 }
 593
 594 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 595 # and should maybe be libraried in some way for other password needs
 596
 597 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 598
 599 sub authenticate_password {
 600   my($self, $check_password) = @_;
 601
 602   if ( $self->_password_encoding eq 'bcrypt' ) {
 603
 604     my( $cost, $salt, $hash ) = split(',', $self->_password);
 605
 606     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 607                                                cost    => $cost,
 608                                                salt    => de_base64($salt),
 609                                              },
 610                                              $check_password
 611                                            )
 612                               );
 613
 614     $hash eq $check_hash;
 615
 616   } else {
 617
 618     return 0 if $self->_password eq '';
 619
 620     $self->_password eq $check_password;
 621
 622   }
 623
 624 }
 625
 626 =item change_password NEW_PASSWORD
 627
 628 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 629 not check password policy rules (see C<is_password_allowed>) and will return
 630 an error only if editing the record fails for some reason.
 631
 632 If NEW_PASSWORD is the same as the existing password, this does nothing.
 633
 634 =cut
 635
 636 sub change_password {
 637   my($self, $new_password) = @_;
 638
 639   # do nothing if the password is unchanged
 640   return if $self->authenticate_password($new_password);
 641
 642   $self->change_password_fields( $new_password );
 643
 644   $self->replace;
 645
 646 }
 647
 648 sub change_password_fields {
 649   my($self, $new_password) = @_;
 650
 651   $self->_password_encoding('bcrypt');
 652
 653   my $cost = 8;
 654
 655   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 656
 657   my $hash = bcrypt_hash( { key_nul => 1,
 658                             cost    => $cost,
 659                             salt    => $salt,
 660                           },
 661                           $new_password,
 662                         );
 663
 664   $self->_password(
 665     join(',', $cost, en_base64($salt), en_base64($hash) )
 666   );
 667
 668 }
 669
 670 # end of false laziness w/FS/FS/Auth/internal.pm
 671
 672
 673 #false laziness w/ClientAPI/MyAccount/reset_passwd
 674 use Digest::SHA qw(sha512_hex);
 675 use FS::Conf;
 676 use FS::ClientAPI_SessionCache;
 677 sub send_reset_email {
 678   my( $self, %opt ) = @_;
 679
 680   my @contact_email = $self->contact_email or return '';
 681
 682   my $reset_session = {
 683     'contactnum' => $self->contactnum,
 684     'svcnum'     => $opt{'svcnum'},
 685   };
 686
 687
 688   my $conf = new FS::Conf;
 689   my $timeout =
 690     ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
 691
 692   my $reset_session_id;
 693   do {
 694     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 695   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 696     #just in case
 697
 698   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 699
 700   #email it
 701
 702   my $cust_main = $self->cust_main
 703     or die "no customer"; #reset a password for a prospect contact?  someday
 704
 705   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $cust_main->agentnum);
 706   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 707   return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
 708   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 709   my %msg_template = (
 710     'to'            => join(',', map $_->emailaddress, @contact_email ),
 711     'cust_main'     => $cust_main,
 712     'object'        => $self,
 713     'substitutions' => { 'session_id' => $reset_session_id }
 714   );
 715
 716   if ( $opt{'queue'} ) { #or should queueing just be the default?
 717
 718     my $queue = new FS::queue {
 719       'job'     => 'FS::Misc::process_send_email',
 720       'custnum' => $cust_main->custnum,
 721     };
 722     $queue->insert( $msg_template->prepare( %msg_template ) );
 723
 724   } else {
 725
 726     $msg_template->send( %msg_template );
 727
 728   }
 729
 730 }
 731
 732 use vars qw( $myaccount_cache );
 733 sub myaccount_cache {
 734   #my $class = shift;
 735   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 736                          'namespace' => 'FS::ClientAPI::MyAccount',
 737                        } );
 738 }
 739
 740 =item cgi_contact_fields
 741
 742 Returns a list reference containing the set of contact fields used in the web
 743 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 744 and locationnum, as well as password fields, but including fields for
 745 contact_email and contact_phone records.)
 746
 747 =cut
 748
 749 sub cgi_contact_fields {
 750   #my $class = shift;
 751
 752   my @contact_fields = qw(
 753     classnum first last title comment emailaddress selfservice_access
 754     invoice_dest password
 755   );
 756
 757   push @contact_fields, 'phonetypenum'. $_->phonetypenum
 758     foreach qsearch({table=>'phone_type', order_by=>'weight'});
 759
 760   \@contact_fields;
 761
 762 }
 763
 764 use FS::phone_type;
 765
 766 =back
 767
 768 =head1 BUGS
 769
 770 =head1 SEE ALSO
 771
 772 L<FS::Record>, schema.html from the base documentation.
 773
 774 =cut
 775
 776 1;
 777