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( qsearchs dbh ); # qw( qsearch qsearchs dbh );
   8 use FS::contact_phone;
   9 use FS::contact_email;
  10 use FS::queue;
  11
  12 $skip_fuzzyfiles = 0;
  13
  14 =head1 NAME
  15
  16 FS::contact - Object methods for contact records
  17
  18 =head1 SYNOPSIS
  19
  20   use FS::contact;
  21
  22   $record = new FS::contact \%hash;
  23   $record = new FS::contact { 'column' => 'value' };
  24
  25   $error = $record->insert;
  26
  27   $error = $new_record->replace($old_record);
  28
  29   $error = $record->delete;
  30
  31   $error = $record->check;
  32
  33 =head1 DESCRIPTION
  34
  35 An FS::contact object represents an example.  FS::contact inherits from
  36 FS::Record.  The following fields are currently supported:
  37
  38 =over 4
  39
  40 =item contactnum
  41
  42 primary key
  43
  44 =item prospectnum
  45
  46 prospectnum
  47
  48 =item custnum
  49
  50 custnum
  51
  52 =item locationnum
  53
  54 locationnum
  55
  56 =item last
  57
  58 last
  59
  60 =item first
  61
  62 first
  63
  64 =item title
  65
  66 title
  67
  68 =item comment
  69
  70 comment
  71
  72 =item selfservice_access
  73
  74 empty or Y
  75
  76 =item _password
  77
  78 =item _password_encoding
  79
  80 empty or bcrypt
  81
  82 =item disabled
  83
  84 disabled
  85
  86
  87 =back
  88
  89 =head1 METHODS
  90
  91 =over 4
  92
  93 =item new HASHREF
  94
  95 Creates a new example.  To add the example to the database, see L<"insert">.
  96
  97 Note that this stores the hash reference, not a distinct copy of the hash it
  98 points to.  You can ask the object for a copy with the I<hash> method.
  99
 100 =cut
 101
 102 # the new method can be inherited from FS::Record, if a table method is defined
 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 # the delete method can be inherited from FS::Record
 198
 199 sub delete {
 200   my $self = shift;
 201
 202   local $SIG{HUP} = 'IGNORE';
 203   local $SIG{INT} = 'IGNORE';
 204   local $SIG{QUIT} = 'IGNORE';
 205   local $SIG{TERM} = 'IGNORE';
 206   local $SIG{TSTP} = 'IGNORE';
 207   local $SIG{PIPE} = 'IGNORE';
 208
 209   my $oldAutoCommit = $FS::UID::AutoCommit;
 210   local $FS::UID::AutoCommit = 0;
 211   my $dbh = dbh;
 212
 213   foreach my $cust_pkg ( $self->cust_pkg ) {
 214     $cust_pkg->contactnum('');
 215     my $error = $cust_pkg->replace;
 216     if ( $error ) {
 217       $dbh->rollback if $oldAutoCommit;
 218       return $error;
 219     }
 220   }
 221
 222   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 223     my $error = $object->delete;
 224     if ( $error ) {
 225       $dbh->rollback if $oldAutoCommit;
 226       return $error;
 227     }
 228   }
 229
 230   my $error = $self->SUPER::delete;
 231   if ( $error ) {
 232     $dbh->rollback if $oldAutoCommit;
 233     return $error;
 234   }
 235
 236   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 237   '';
 238
 239 }
 240
 241 =item replace OLD_RECORD
 242
 243 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 244 returns the error, otherwise returns false.
 245
 246 =cut
 247
 248 sub replace {
 249   my $self = shift;
 250
 251   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 252               ? shift
 253               : $self->replace_old;
 254
 255   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 256
 257   local $SIG{INT} = 'IGNORE';
 258   local $SIG{QUIT} = 'IGNORE';
 259   local $SIG{TERM} = 'IGNORE';
 260   local $SIG{TSTP} = 'IGNORE';
 261   local $SIG{PIPE} = 'IGNORE';
 262
 263   my $oldAutoCommit = $FS::UID::AutoCommit;
 264   local $FS::UID::AutoCommit = 0;
 265   my $dbh = dbh;
 266
 267   my $error = $self->SUPER::replace($old);
 268   if ( $error ) {
 269     $dbh->rollback if $oldAutoCommit;
 270     return $error;
 271   }
 272
 273   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) }
 274                         keys %{ $self->hashref } ) {
 275     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 276     my $phonetypenum = $1;
 277
 278     my %cp = ( 'contactnum'   => $self->contactnum,
 279                'phonetypenum' => $phonetypenum,
 280              );
 281     my $contact_phone = qsearchs('contact_phone', \%cp)
 282                         || new FS::contact_phone   \%cp;
 283
 284     my %cpd = _parse_phonestring( $self->get($pf) );
 285     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 286
 287     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 288
 289     $error = $contact_phone->$method;
 290     if ( $error ) {
 291       $dbh->rollback if $oldAutoCommit;
 292       return $error;
 293     }
 294   }
 295
 296   if ( defined($self->hashref->{'emailaddress'}) ) {
 297
 298     #ineffecient but whatever, how many email addresses can there be?
 299
 300     foreach my $contact_email ( $self->contact_email ) {
 301       my $error = $contact_email->delete;
 302       if ( $error ) {
 303         $dbh->rollback if $oldAutoCommit;
 304         return $error;
 305       }
 306     }
 307
 308     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 309
 310       my $contact_email = new FS::contact_email {
 311         'contactnum'   => $self->contactnum,
 312         'emailaddress' => $email,
 313       };
 314       $error = $contact_email->insert;
 315       if ( $error ) {
 316         $dbh->rollback if $oldAutoCommit;
 317         return $error;
 318       }
 319
 320     }
 321
 322   }
 323
 324   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 325     #warn "  queueing fuzzyfiles update\n"
 326     #  if $DEBUG > 1;
 327     $error = $self->queue_fuzzyfiles_update;
 328     if ( $error ) {
 329       $dbh->rollback if $oldAutoCommit;
 330       return "updating fuzzy search cache: $error";
 331     }
 332   }
 333
 334   if (    ( $old->selfservice_access eq '' && $self->selfservice_access
 335               && ! $self->_password
 336           )
 337        || $self->_resend()
 338      )
 339   {
 340     my $error = $self->send_reset_email( queue=>1 );
 341     if ( $error ) {
 342       $dbh->rollback if $oldAutoCommit;
 343       return $error;
 344     }
 345   }
 346
 347   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 348
 349   '';
 350
 351 }
 352
 353 #i probably belong in contact_phone.pm
 354 sub _parse_phonestring {
 355   my $value = shift;
 356
 357   my($countrycode, $extension) = ('1', '');
 358
 359   #countrycode
 360   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 361     $countrycode = $1;
 362   } else {
 363     $value =~ s/^\s*1//;
 364   }
 365   #extension
 366   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 367      $extension = $2;
 368   }
 369
 370   ( 'countrycode' => $countrycode,
 371     'phonenum'    => $value,
 372     'extension'   => $extension,
 373   );
 374 }
 375
 376 =item queue_fuzzyfiles_update
 377
 378 Used by insert & replace to update the fuzzy search cache
 379
 380 =cut
 381
 382 use FS::cust_main::Search;
 383 sub queue_fuzzyfiles_update {
 384   my $self = shift;
 385
 386   local $SIG{HUP} = 'IGNORE';
 387   local $SIG{INT} = 'IGNORE';
 388   local $SIG{QUIT} = 'IGNORE';
 389   local $SIG{TERM} = 'IGNORE';
 390   local $SIG{TSTP} = 'IGNORE';
 391   local $SIG{PIPE} = 'IGNORE';
 392
 393   my $oldAutoCommit = $FS::UID::AutoCommit;
 394   local $FS::UID::AutoCommit = 0;
 395   my $dbh = dbh;
 396
 397   foreach my $field ( 'first', 'last' ) {
 398     my $queue = new FS::queue {
 399       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 400     };
 401     my @args = "contact.$field", $self->get($field);
 402     my $error = $queue->insert( @args );
 403     if ( $error ) {
 404       $dbh->rollback if $oldAutoCommit;
 405       return "queueing job (transaction rolled back): $error";
 406     }
 407   }
 408
 409   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 410   '';
 411
 412 }
 413
 414 =item check
 415
 416 Checks all fields to make sure this is a valid example.  If there is
 417 an error, returns the error, otherwise returns false.  Called by the insert
 418 and replace methods.
 419
 420 =cut
 421
 422 # the check method should currently be supplied - FS::Record contains some
 423 # data checking routines
 424
 425 sub check {
 426   my $self = shift;
 427
 428   if ( $self->selfservice_access eq 'R' ) {
 429     $self->selfservice_access('Y');
 430     $self->_resend('Y');
 431   }
 432
 433   my $error =
 434     $self->ut_numbern('contactnum')
 435     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 436     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 437     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 438     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 439     || $self->ut_namen('last')
 440     || $self->ut_namen('first')
 441     || $self->ut_textn('title')
 442     || $self->ut_textn('comment')
 443     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 444     || $self->ut_textn('_password')
 445     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 446     || $self->ut_enum('disabled', [ '', 'Y' ])
 447   ;
 448   return $error if $error;
 449
 450   return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
 451   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 452
 453   return "One of first name, last name, or title must have a value"
 454     if ! grep $self->$_(), qw( first last title);
 455
 456   $self->SUPER::check;
 457 }
 458
 459 sub line {
 460   my $self = shift;
 461   my $data = $self->first. ' '. $self->last;
 462   $data .= ', '. $self->title
 463     if $self->title;
 464   $data .= ' ('. $self->comment. ')'
 465     if $self->comment;
 466   $data;
 467 }
 468
 469 sub firstlast {
 470   my $self = shift;
 471   $self->first . ' ' . $self->last;
 472 }
 473
 474 sub contact_classname {
 475   my $self = shift;
 476   my $contact_class = $self->contact_class or return '';
 477   $contact_class->classname;
 478 }
 479
 480 sub by_selfservice_email {
 481   my($class, $email) = @_;
 482
 483   my $contact_email = qsearchs({
 484     'table'     => 'contact_email',
 485     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 486     'hashref'   => { 'emailaddress' => $email, },
 487     'extra_sql' => " AND selfservice_access = 'Y' ".
 488                    " AND ( disabled IS NULL OR disabled = '' )",
 489   }) or return '';
 490
 491   $contact_email->contact;
 492
 493 }
 494
 495 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 496 # and should maybe be libraried in some way for other password needs
 497
 498 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 499
 500 sub authenticate_password {
 501   my($self, $check_password) = @_;
 502
 503   if ( $self->_password_encoding eq 'bcrypt' ) {
 504
 505     my( $cost, $salt, $hash ) = split(',', $self->_password);
 506
 507     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 508                                                cost    => $cost,
 509                                                salt    => de_base64($salt),
 510                                              },
 511                                              $check_password
 512                                            )
 513                               );
 514
 515     $hash eq $check_hash;
 516
 517   } else {
 518
 519     return 0 if $self->_password eq '';
 520
 521     $self->_password eq $check_password;
 522
 523   }
 524
 525 }
 526
 527 sub change_password {
 528   my($self, $new_password) = @_;
 529
 530   $self->change_password_fields( $new_password );
 531
 532   $self->replace;
 533
 534 }
 535
 536 sub change_password_fields {
 537   my($self, $new_password) = @_;
 538
 539   $self->_password_encoding('bcrypt');
 540
 541   my $cost = 8;
 542
 543   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 544
 545   my $hash = bcrypt_hash( { key_nul => 1,
 546                             cost    => $cost,
 547                             salt    => $salt,
 548                           },
 549                           $new_password,
 550                         );
 551
 552   $self->_password(
 553     join(',', $cost, en_base64($salt), en_base64($hash) )
 554   );
 555
 556 }
 557
 558 # end of false laziness w/FS/FS/Auth/internal.pm
 559
 560
 561 #false laziness w/ClientAPI/MyAccount/reset_passwd
 562 use Digest::SHA qw(sha512_hex);
 563 use FS::Conf;
 564 use FS::ClientAPI_SessionCache;
 565 sub send_reset_email {
 566   my( $self, %opt ) = @_;
 567
 568   my @contact_email = $self->contact_email or return '';
 569
 570   my $reset_session = {
 571     'contactnum' => $self->contactnum,
 572     'svcnum'     => $opt{'svcnum'},
 573   };
 574
 575   my $timeout = '24 hours'; #?
 576
 577   my $reset_session_id;
 578   do {
 579     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 580   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 581     #just in case
 582
 583   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 584
 585   #email it
 586
 587   my $conf = new FS::Conf;
 588
 589   my $cust_main = $self->cust_main
 590     or die "no customer"; #reset a password for a prospect contact?  someday
 591
 592   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $cust_main->agentnum);
 593   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 594   return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
 595   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 596   my %msg_template = (
 597     'to'            => join(',', map $_->emailaddress, @contact_email ),
 598     'cust_main'     => $cust_main,
 599     'object'        => $self,
 600     'substitutions' => { 'session_id' => $reset_session_id }
 601   );
 602
 603   if ( $opt{'queue'} ) { #or should queueing just be the default?
 604
 605     my $queue = new FS::queue {
 606       'job'     => 'FS::Misc::process_send_email',
 607       'custnum' => $cust_main->custnum,
 608     };
 609     $queue->insert( $msg_template->prepare( %msg_template ) );
 610
 611   } else {
 612
 613     $msg_template->send( %msg_template );
 614
 615   }
 616
 617 }
 618
 619 use vars qw( $myaccount_cache );
 620 sub myaccount_cache {
 621   #my $class = shift;
 622   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 623                          'namespace' => 'FS::ClientAPI::MyAccount',
 624                        } );
 625 }
 626
 627 =back
 628
 629 =head1 BUGS
 630
 631 =head1 SEE ALSO
 632
 633 L<FS::Record>, schema.html from the base documentation.
 634
 635 =cut
 636
 637 1;
 638