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