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