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