FS/FS/contact.pm

   1 package FS::contact;
   2 use base qw( FS::Record );
   3
   4 use strict;
   5 use Scalar::Util qw( blessed );
   6 use FS::Record qw( qsearch qsearchs dbh );
   7 use FS::prospect_main;
   8 use FS::cust_main;
   9 use FS::contact_class;
  10 use FS::cust_location;
  11 use FS::contact_phone;
  12 use FS::contact_email;
  13 use FS::queue;
  14 use FS::cust_pkg;
  15
  16 =head1 NAME
  17
  18 FS::contact - Object methods for contact records
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::contact;
  23
  24   $record = new FS::contact \%hash;
  25   $record = new FS::contact { 'column' => 'value' };
  26
  27   $error = $record->insert;
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35 =head1 DESCRIPTION
  36
  37 An FS::contact object represents an example.  FS::contact inherits from
  38 FS::Record.  The following fields are 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 example.  To add the example 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 # the new method can be inherited from FS::Record, if a table method is defined
 105
 106 sub table { 'contact'; }
 107
 108 =item insert
 109
 110 Adds this record to the database.  If there is an error, returns the error,
 111 otherwise returns false.
 112
 113 =cut
 114
 115 sub insert {
 116   my $self = shift;
 117
 118   local $SIG{INT} = 'IGNORE';
 119   local $SIG{QUIT} = 'IGNORE';
 120   local $SIG{TERM} = 'IGNORE';
 121   local $SIG{TSTP} = 'IGNORE';
 122   local $SIG{PIPE} = 'IGNORE';
 123
 124   my $oldAutoCommit = $FS::UID::AutoCommit;
 125   local $FS::UID::AutoCommit = 0;
 126   my $dbh = dbh;
 127
 128   my $error = $self->SUPER::insert;
 129   if ( $error ) {
 130     $dbh->rollback if $oldAutoCommit;
 131     return $error;
 132   }
 133
 134   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 135                         keys %{ $self->hashref } ) {
 136     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 137     my $phonetypenum = $1;
 138
 139     my $contact_phone = new FS::contact_phone {
 140       'contactnum' => $self->contactnum,
 141       'phonetypenum' => $phonetypenum,
 142       _parse_phonestring( $self->get($pf) ),
 143     };
 144     $error = $contact_phone->insert;
 145     if ( $error ) {
 146       $dbh->rollback if $oldAutoCommit;
 147       return $error;
 148     }
 149   }
 150
 151   if ( $self->get('emailaddress') =~ /\S/ ) {
 152
 153     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 154
 155       my $contact_email = new FS::contact_email {
 156         'contactnum'   => $self->contactnum,
 157         'emailaddress' => $email,
 158       };
 159       $error = $contact_email->insert;
 160       if ( $error ) {
 161         $dbh->rollback if $oldAutoCommit;
 162         return $error;
 163       }
 164
 165     }
 166
 167   }
 168
 169   #unless ( $import || $skip_fuzzyfiles ) {
 170     #warn "  queueing fuzzyfiles update\n"
 171     #  if $DEBUG > 1;
 172     $error = $self->queue_fuzzyfiles_update;
 173     if ( $error ) {
 174       $dbh->rollback if $oldAutoCommit;
 175       return "updating fuzzy search cache: $error";
 176     }
 177   #}
 178
 179   if ( $self->selfservice_access ) {
 180     my $error = $self->send_reset_email( queue=>1 );
 181     if ( $error ) {
 182       $dbh->rollback if $oldAutoCommit;
 183       return $error;
 184     }
 185   }
 186
 187   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 188
 189   '';
 190
 191 }
 192
 193 =item delete
 194
 195 Delete this record from the database.
 196
 197 =cut
 198
 199 # the delete method can be inherited from FS::Record
 200
 201 sub delete {
 202   my $self = shift;
 203
 204   local $SIG{HUP} = 'IGNORE';
 205   local $SIG{INT} = 'IGNORE';
 206   local $SIG{QUIT} = 'IGNORE';
 207   local $SIG{TERM} = 'IGNORE';
 208   local $SIG{TSTP} = 'IGNORE';
 209   local $SIG{PIPE} = 'IGNORE';
 210
 211   my $oldAutoCommit = $FS::UID::AutoCommit;
 212   local $FS::UID::AutoCommit = 0;
 213   my $dbh = dbh;
 214
 215   foreach my $cust_pkg ( $self->cust_pkg ) {
 216     $cust_pkg->contactnum('');
 217     my $error = $cust_pkg->replace;
 218     if ( $error ) {
 219       $dbh->rollback if $oldAutoCommit;
 220       return $error;
 221     }
 222   }
 223
 224   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 225     my $error = $object->delete;
 226     if ( $error ) {
 227       $dbh->rollback if $oldAutoCommit;
 228       return $error;
 229     }
 230   }
 231
 232   my $error = $self->SUPER::delete;
 233   if ( $error ) {
 234     $dbh->rollback if $oldAutoCommit;
 235     return $error;
 236   }
 237
 238   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 239   '';
 240
 241 }
 242
 243 =item replace OLD_RECORD
 244
 245 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 246 returns the error, otherwise returns false.
 247
 248 =cut
 249
 250 sub replace {
 251   my $self = shift;
 252
 253   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 254               ? shift
 255               : $self->replace_old;
 256
 257   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 258
 259   local $SIG{INT} = 'IGNORE';
 260   local $SIG{QUIT} = 'IGNORE';
 261   local $SIG{TERM} = 'IGNORE';
 262   local $SIG{TSTP} = 'IGNORE';
 263   local $SIG{PIPE} = 'IGNORE';
 264
 265   my $oldAutoCommit = $FS::UID::AutoCommit;
 266   local $FS::UID::AutoCommit = 0;
 267   my $dbh = dbh;
 268
 269   my $error = $self->SUPER::replace($old);
 270   if ( $error ) {
 271     $dbh->rollback if $oldAutoCommit;
 272     return $error;
 273   }
 274
 275   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) }
 276                         keys %{ $self->hashref } ) {
 277     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 278     my $phonetypenum = $1;
 279
 280     my %cp = ( 'contactnum'   => $self->contactnum,
 281                'phonetypenum' => $phonetypenum,
 282              );
 283     my $contact_phone = qsearchs('contact_phone', \%cp)
 284                         || new FS::contact_phone   \%cp;
 285
 286     my %cpd = _parse_phonestring( $self->get($pf) );
 287     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 288
 289     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 290
 291     $error = $contact_phone->$method;
 292     if ( $error ) {
 293       $dbh->rollback if $oldAutoCommit;
 294       return $error;
 295     }
 296   }
 297
 298   if ( defined($self->hashref->{'emailaddress'}) ) {
 299
 300     #ineffecient but whatever, how many email addresses can there be?
 301
 302     foreach my $contact_email ( $self->contact_email ) {
 303       my $error = $contact_email->delete;
 304       if ( $error ) {
 305         $dbh->rollback if $oldAutoCommit;
 306         return $error;
 307       }
 308     }
 309
 310     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 311
 312       my $contact_email = new FS::contact_email {
 313         'contactnum'   => $self->contactnum,
 314         'emailaddress' => $email,
 315       };
 316       $error = $contact_email->insert;
 317       if ( $error ) {
 318         $dbh->rollback if $oldAutoCommit;
 319         return $error;
 320       }
 321
 322     }
 323
 324   }
 325
 326   #unless ( $import || $skip_fuzzyfiles ) {
 327     #warn "  queueing fuzzyfiles update\n"
 328     #  if $DEBUG > 1;
 329     $error = $self->queue_fuzzyfiles_update;
 330     if ( $error ) {
 331       $dbh->rollback if $oldAutoCommit;
 332       return "updating fuzzy search cache: $error";
 333     }
 334   #}
 335
 336   if (    ( $old->selfservice_access eq '' && $self->selfservice_access
 337               && ! $self->_password
 338           )
 339        || $self->_resend()
 340      )
 341   {
 342     my $error = $self->send_reset_email( queue=>1 );
 343     if ( $error ) {
 344       $dbh->rollback if $oldAutoCommit;
 345       return $error;
 346     }
 347   }
 348
 349   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 350
 351   '';
 352
 353 }
 354
 355 #i probably belong in contact_phone.pm
 356 sub _parse_phonestring {
 357   my $value = shift;
 358
 359   my($countrycode, $extension) = ('1', '');
 360
 361   #countrycode
 362   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 363     $countrycode = $1;
 364   } else {
 365     $value =~ s/^\s*1//;
 366   }
 367   #extension
 368   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 369      $extension = $2;
 370   }
 371
 372   ( 'countrycode' => $countrycode,
 373     'phonenum'    => $value,
 374     'extension'   => $extension,
 375   );
 376 }
 377
 378 =item queue_fuzzyfiles_update
 379
 380 Used by insert & replace to update the fuzzy search cache
 381
 382 =cut
 383
 384 use FS::cust_main::Search;
 385 sub queue_fuzzyfiles_update {
 386   my $self = shift;
 387
 388   local $SIG{HUP} = 'IGNORE';
 389   local $SIG{INT} = 'IGNORE';
 390   local $SIG{QUIT} = 'IGNORE';
 391   local $SIG{TERM} = 'IGNORE';
 392   local $SIG{TSTP} = 'IGNORE';
 393   local $SIG{PIPE} = 'IGNORE';
 394
 395   my $oldAutoCommit = $FS::UID::AutoCommit;
 396   local $FS::UID::AutoCommit = 0;
 397   my $dbh = dbh;
 398
 399   foreach my $field ( 'first', 'last' ) {
 400     my $queue = new FS::queue {
 401       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 402     };
 403     my @args = "contact.$field", $self->get($field);
 404     my $error = $queue->insert( @args );
 405     if ( $error ) {
 406       $dbh->rollback if $oldAutoCommit;
 407       return "queueing job (transaction rolled back): $error";
 408     }
 409   }
 410
 411   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 412   '';
 413
 414 }
 415
 416 =item check
 417
 418 Checks all fields to make sure this is a valid example.  If there is
 419 an error, returns the error, otherwise returns false.  Called by the insert
 420 and replace methods.
 421
 422 =cut
 423
 424 # the check method should currently be supplied - FS::Record contains some
 425 # data checking routines
 426
 427 sub check {
 428   my $self = shift;
 429
 430   if ( $self->selfservice_access eq 'R' ) {
 431     $self->selfservice_access('Y');
 432     $self->_resend('Y');
 433   }
 434
 435   my $error =
 436     $self->ut_numbern('contactnum')
 437     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 438     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 439     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 440     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 441     || $self->ut_namen('last')
 442     || $self->ut_namen('first')
 443     || $self->ut_textn('title')
 444     || $self->ut_textn('comment')
 445     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 446     || $self->ut_textn('_password')
 447     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 448     || $self->ut_enum('disabled', [ '', 'Y' ])
 449   ;
 450   return $error if $error;
 451
 452   return "No prospect or customer!" unless $self->prospectnum || $self->custnum;
 453   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 454
 455   return "One of first name, last name, or title must have a value"
 456     if ! grep $self->$_(), qw( first last title);
 457
 458   $self->SUPER::check;
 459 }
 460
 461 sub line {
 462   my $self = shift;
 463   my $data = $self->first. ' '. $self->last;
 464   $data .= ', '. $self->title
 465     if $self->title;
 466   $data .= ' ('. $self->comment. ')'
 467     if $self->comment;
 468   $data;
 469 }
 470
 471 sub cust_location {
 472   my $self = shift;
 473   return '' unless $self->locationnum;
 474   qsearchs('cust_location', { 'locationnum' => $self->locationnum } );
 475 }
 476
 477 sub contact_class {
 478   my $self = shift;
 479   return '' unless $self->classnum;
 480   qsearchs('contact_class', { 'classnum' => $self->classnum } );
 481 }
 482
 483 sub contact_classname {
 484   my $self = shift;
 485   my $contact_class = $self->contact_class or return '';
 486   $contact_class->classname;
 487 }
 488
 489 sub contact_phone {
 490   my $self = shift;
 491   qsearch('contact_phone', { 'contactnum' => $self->contactnum } );
 492 }
 493
 494 sub contact_email {
 495   my $self = shift;
 496   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 497 }
 498
 499 sub cust_main {
 500   my $self = shift;
 501   qsearchs('cust_main', { 'custnum' => $self->custnum  } );
 502 }
 503
 504 sub cust_pkg {
 505   my $self = shift;
 506   qsearch('cust_pkg', { 'contactnum' => $self->contactnum  } );
 507 }
 508
 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 =back
 658
 659 =head1 BUGS
 660
 661 =head1 SEE ALSO
 662
 663 L<FS::Record>, schema.html from the base documentation.
 664
 665 =cut
 666
 667 1;
 668