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