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