FS/FS/contact.pm

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