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