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