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