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