FS/FS/contact.pm

   1 package FS::contact;
   2 use base qw( FS::Password_Mixin
   3              FS::Record );
   4
   5 use strict;
   6 use vars qw( $skip_fuzzyfiles );
   7 use Carp;
   8 use Scalar::Util qw( blessed );
   9 use FS::Record qw( qsearch qsearchs dbh );
  10 use FS::Cursor;
  11 use FS::contact_phone;
  12 use FS::contact_email;
  13 use FS::queue;
  14 use FS::phone_type; #for cgi_contact_fields
  15 use FS::cust_contact;
  16 use FS::prospect_contact;
  17
  18 $skip_fuzzyfiles = 0;
  19
  20 =head1 NAME
  21
  22 FS::contact - Object methods for contact records
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::contact;
  27
  28   $record = new FS::contact \%hash;
  29   $record = new FS::contact { 'column' => 'value' };
  30
  31   $error = $record->insert;
  32
  33   $error = $new_record->replace($old_record);
  34
  35   $error = $record->delete;
  36
  37   $error = $record->check;
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::contact object represents an specific contact person for a prospect or
  42 customer.  FS::contact inherits from FS::Record.  The following fields are
  43 currently supported:
  44
  45 =over 4
  46
  47 =item contactnum
  48
  49 primary key
  50
  51 =item prospectnum
  52
  53 prospectnum
  54
  55 =item custnum
  56
  57 custnum
  58
  59 =item locationnum
  60
  61 locationnum
  62
  63 =item last
  64
  65 last
  66
  67 =item first
  68
  69 first
  70
  71 =item title
  72
  73 title
  74
  75 =item comment
  76
  77 comment
  78
  79 =item selfservice_access
  80
  81 empty or Y
  82
  83 =item _password
  84
  85 =item _password_encoding
  86
  87 empty or bcrypt
  88
  89 =item disabled
  90
  91 disabled
  92
  93 =back
  94
  95 =head1 METHODS
  96
  97 =over 4
  98
  99 =item new HASHREF
 100
 101 Creates a new contact.  To add the contact to the database, see L<"insert">.
 102
 103 Note that this stores the hash reference, not a distinct copy of the hash it
 104 points to.  You can ask the object for a copy with the I<hash> method.
 105
 106 =cut
 107
 108 sub table { 'contact'; }
 109
 110 =item insert
 111
 112 Adds this record to the database.  If there is an error, returns the error,
 113 otherwise returns false.
 114
 115 If the object has an C<emailaddress> field, L<FS::contact_email> records will
 116 be created for each (comma-separated) email address in that field. If any of
 117 these coincide with an existing email address, this contact will be merged with
 118 the contact with that address.
 119
 120 Then, if the object has any fields named C<phonetypenumN> an
 121 L<FS::contact_phone> record will be created for each of them. Those fields
 122 should contain phone numbers of the appropriate types (where N is the key of
 123 an L<FS::phone_type> record identifying the type of number: daytime, night,
 124 etc.).
 125
 126 After inserting the record, if the object has a 'custnum' or 'prospectnum'
 127 field, an L<FS::cust_contact> or L<FS::prospect_contact> record will be
 128 created to link the contact to the customer. The following fields will also
 129 be included in that record, if they are set on the object:
 130 - classnum
 131 - comment
 132 - selfservice_access
 133 - invoice_dest
 134
 135 =cut
 136
 137 sub insert {
 138   my $self = shift;
 139
 140   local $SIG{INT} = 'IGNORE';
 141   local $SIG{QUIT} = 'IGNORE';
 142   local $SIG{TERM} = 'IGNORE';
 143   local $SIG{TSTP} = 'IGNORE';
 144   local $SIG{PIPE} = 'IGNORE';
 145
 146   my $oldAutoCommit = $FS::UID::AutoCommit;
 147   local $FS::UID::AutoCommit = 0;
 148   my $dbh = dbh;
 149
 150   #save off and blank values that move to cust_contact / prospect_contact now
 151   my $prospectnum = $self->prospectnum;
 152   $self->prospectnum('');
 153   my $custnum = $self->custnum;
 154   $self->custnum('');
 155
 156   my %link_hash = ();
 157   for (qw( classnum comment selfservice_access invoice_dest )) {
 158     $link_hash{$_} = $self->get($_);
 159     $self->$_('');
 160   }
 161
 162   #look for an existing contact with this email address
 163   my $existing_contact = '';
 164   if ( $self->get('emailaddress') =~ /\S/ ) {
 165
 166     my %existing_contact = ();
 167
 168     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 169
 170       my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
 171         or next;
 172
 173       my $contact = $contact_email->contact;
 174       $existing_contact{ $contact->contactnum } = $contact;
 175
 176     }
 177
 178     if ( scalar( keys %existing_contact ) > 1 ) {
 179       $dbh->rollback if $oldAutoCommit;
 180       return 'Multiple email addresses specified '.
 181              ' that already belong to separate contacts';
 182     } elsif ( scalar( keys %existing_contact ) ) {
 183       ($existing_contact) = values %existing_contact;
 184     }
 185
 186   }
 187
 188   my $error;
 189   if ( $existing_contact ) {
 190
 191     $self->$_($existing_contact->$_())
 192       for qw( contactnum _password _password_encoding );
 193     $error = $self->SUPER::replace($existing_contact);
 194
 195   } else {
 196
 197     $error = $self->SUPER::insert;
 198
 199   }
 200
 201   $error ||= $self->insert_password_history;
 202
 203   if ( $error ) {
 204     $dbh->rollback if $oldAutoCommit;
 205     return $error;
 206   }
 207
 208   my $cust_contact = '';
 209   if ( $custnum ) {
 210     my %hash = ( 'contactnum' => $self->contactnum,
 211                  'custnum'    => $custnum,
 212                );
 213     $cust_contact =  qsearchs('cust_contact', \%hash )
 214                   || new FS::cust_contact { %hash, %link_hash };
 215     my $error = $cust_contact->custcontactnum ? $cust_contact->replace
 216                                               : $cust_contact->insert;
 217     if ( $error ) {
 218       $dbh->rollback if $oldAutoCommit;
 219       return $error;
 220     }
 221   }
 222
 223   if ( $prospectnum ) {
 224     my %hash = ( 'contactnum'  => $self->contactnum,
 225                  'prospectnum' => $prospectnum,
 226                );
 227     my $prospect_contact =  qsearchs('prospect_contact', \%hash )
 228                          || new FS::prospect_contact { %hash, %link_hash };
 229     my $error =
 230       $prospect_contact->prospectcontactnum ? $prospect_contact->replace
 231                                             : $prospect_contact->insert;
 232     if ( $error ) {
 233       $dbh->rollback if $oldAutoCommit;
 234       return $error;
 235     }
 236   }
 237
 238   foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
 239                         keys %{ $self->hashref } ) {
 240     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 241     my $phonetypenum = $1;
 242
 243     my %hash = ( 'contactnum'   => $self->contactnum,
 244                  'phonetypenum' => $phonetypenum,
 245                );
 246     my $contact_phone =
 247       qsearchs('contact_phone', \%hash)
 248         || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
 249     my $error = $contact_phone->contactphonenum ? $contact_phone->replace
 250                                                 : $contact_phone->insert;
 251     if ( $error ) {
 252       $dbh->rollback if $oldAutoCommit;
 253       return $error;
 254     }
 255   }
 256
 257   if ( $self->get('emailaddress') =~ /\S/ ) {
 258
 259     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 260       my %hash = (
 261         'contactnum'   => $self->contactnum,
 262         'emailaddress' => $email,
 263       );
 264       unless ( qsearchs('contact_email', \%hash) ) {
 265         my $contact_email = new FS::contact_email \%hash;
 266         my $error = $contact_email->insert;
 267         if ( $error ) {
 268           $dbh->rollback if $oldAutoCommit;
 269           return $error;
 270         }
 271       }
 272     }
 273
 274   }
 275
 276   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 277     #warn "  queueing fuzzyfiles update\n"
 278     #  if $DEBUG > 1;
 279     my $error = $self->queue_fuzzyfiles_update;
 280     if ( $error ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return "updating fuzzy search cache: $error";
 283     }
 284   }
 285
 286   if (      $link_hash{'selfservice_access'} eq 'R'
 287        or ( $link_hash{'selfservice_access'}
 288             && $cust_contact
 289             && ! length($self->_password)
 290           )
 291      )
 292   {
 293     my $error = $self->send_reset_email( queue=>1 );
 294     if ( $error ) {
 295       $dbh->rollback if $oldAutoCommit;
 296       return $error;
 297     }
 298   }
 299
 300   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 301
 302   '';
 303
 304 }
 305
 306 =item delete
 307
 308 Delete this record from the database.
 309
 310 =cut
 311
 312 sub delete {
 313   my $self = shift;
 314
 315   local $SIG{HUP} = 'IGNORE';
 316   local $SIG{INT} = 'IGNORE';
 317   local $SIG{QUIT} = 'IGNORE';
 318   local $SIG{TERM} = 'IGNORE';
 319   local $SIG{TSTP} = 'IGNORE';
 320   local $SIG{PIPE} = 'IGNORE';
 321
 322   my $oldAutoCommit = $FS::UID::AutoCommit;
 323   local $FS::UID::AutoCommit = 0;
 324   my $dbh = dbh;
 325
 326   #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
 327
 328   if ( $self->prospectnum ) {
 329     my $prospect_contact = qsearchs('prospect_contact', {
 330                              'contactnum'  => $self->contactnum,
 331                              'prospectnum' => $self->prospectnum,
 332                            });
 333     my $error = $prospect_contact->delete;
 334     if ( $error ) {
 335       $dbh->rollback if $oldAutoCommit;
 336       return $error;
 337     }
 338   }
 339
 340   if ( $self->custnum ) {
 341     my $cust_contact = qsearchs('cust_contact', {
 342                          'contactnum'  => $self->contactnum,
 343                          'custnum' => $self->custnum,
 344                        });
 345     my $error = $cust_contact->delete;
 346     if ( $error ) {
 347       $dbh->rollback if $oldAutoCommit;
 348       return $error;
 349     }
 350   }
 351
 352   # then, proceed with deletion only if the contact isn't attached to any other
 353   # prospects or customers
 354
 355   #inefficient, but how many prospects/customers can a single contact be
 356   # attached too?  (and is removing them from one a common operation?)
 357   if ( $self->prospect_contact || $self->cust_contact ) {
 358     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 359     return '';
 360   }
 361
 362   #proceed with deletion
 363
 364   foreach my $cust_pkg ( $self->cust_pkg ) {
 365     $cust_pkg->contactnum('');
 366     my $error = $cust_pkg->replace;
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371   }
 372
 373   foreach my $object ( $self->contact_phone, $self->contact_email ) {
 374     my $error = $object->delete;
 375     if ( $error ) {
 376       $dbh->rollback if $oldAutoCommit;
 377       return $error;
 378     }
 379   }
 380
 381   my $error = $self->delete_password_history
 382            || $self->SUPER::delete;
 383   if ( $error ) {
 384     $dbh->rollback if $oldAutoCommit;
 385     return $error;
 386   }
 387
 388   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 389   '';
 390
 391 }
 392
 393 =item replace OLD_RECORD
 394
 395 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 396 returns the error, otherwise returns false.
 397
 398 =cut
 399
 400 sub replace {
 401   my $self = shift;
 402
 403   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 404               ? shift
 405               : $self->replace_old;
 406
 407   $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
 408
 409   local $SIG{INT} = 'IGNORE';
 410   local $SIG{QUIT} = 'IGNORE';
 411   local $SIG{TERM} = 'IGNORE';
 412   local $SIG{TSTP} = 'IGNORE';
 413   local $SIG{PIPE} = 'IGNORE';
 414
 415   my $oldAutoCommit = $FS::UID::AutoCommit;
 416   local $FS::UID::AutoCommit = 0;
 417   my $dbh = dbh;
 418
 419   #save off and blank values that move to cust_contact / prospect_contact now
 420   my $prospectnum = $self->prospectnum;
 421   $self->prospectnum('');
 422   my $custnum = $self->custnum;
 423   $self->custnum('');
 424
 425   my %link_hash = ();
 426   for (qw( classnum comment selfservice_access invoice_dest )) {
 427     $link_hash{$_} = $self->get($_);
 428     $self->$_('');
 429   }
 430
 431   my $error = $self->SUPER::replace($old);
 432   if ( $old->_password ne $self->_password ) {
 433     $error ||= $self->insert_password_history;
 434   }
 435   if ( $error ) {
 436     $dbh->rollback if $oldAutoCommit;
 437     return $error;
 438   }
 439
 440   my $cust_contact = '';
 441   if ( $custnum ) {
 442     my %hash = ( 'contactnum' => $self->contactnum,
 443                  'custnum'    => $custnum,
 444                );
 445     my $error;
 446     if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
 447       $cust_contact->$_($link_hash{$_}) for keys %link_hash;
 448       $error = $cust_contact->replace;
 449     } else {
 450       $cust_contact = new FS::cust_contact { %hash, %link_hash };
 451       $error = $cust_contact->insert;
 452     }
 453     if ( $error ) {
 454       $dbh->rollback if $oldAutoCommit;
 455       return $error;
 456     }
 457   }
 458
 459   if ( $prospectnum ) {
 460     my %hash = ( 'contactnum'  => $self->contactnum,
 461                  'prospectnum' => $prospectnum,
 462                );
 463     my $error;
 464     if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
 465       $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
 466       $error = $prospect_contact->replace;
 467     } else {
 468       my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
 469       $error = $prospect_contact->insert;
 470     }
 471     if ( $error ) {
 472       $dbh->rollback if $oldAutoCommit;
 473       return $error;
 474     }
 475   }
 476
 477   foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
 478                         keys %{ $self->hashref } ) {
 479     $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
 480     my $phonetypenum = $1;
 481
 482     my %cp = ( 'contactnum'   => $self->contactnum,
 483                'phonetypenum' => $phonetypenum,
 484              );
 485     my $contact_phone = qsearchs('contact_phone', \%cp);
 486
 487     my $pv = $self->get($pf);
 488         $pv =~ s/\s//g;
 489
 490     #if new value is empty, delete old entry
 491     if (!$pv) {
 492       if ($contact_phone) {
 493         $error = $contact_phone->delete;
 494         if ( $error ) {
 495           $dbh->rollback if $oldAutoCommit;
 496           return $error;
 497         }
 498       }
 499       next;
 500     }
 501
 502     $contact_phone ||= new FS::contact_phone \%cp;
 503
 504     my %cpd = _parse_phonestring( $pv );
 505     $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
 506
 507     my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
 508
 509     $error = $contact_phone->$method;
 510     if ( $error ) {
 511       $dbh->rollback if $oldAutoCommit;
 512       return $error;
 513     }
 514   }
 515
 516   if ( defined($self->hashref->{'emailaddress'}) ) {
 517
 518     #ineffecient but whatever, how many email addresses can there be?
 519
 520     foreach my $contact_email ( $self->contact_email ) {
 521       my $error = $contact_email->delete;
 522       if ( $error ) {
 523         $dbh->rollback if $oldAutoCommit;
 524         return $error;
 525       }
 526     }
 527
 528     foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
 529
 530       my $contact_email = new FS::contact_email {
 531         'contactnum'   => $self->contactnum,
 532         'emailaddress' => $email,
 533       };
 534       $error = $contact_email->insert;
 535       if ( $error ) {
 536         $dbh->rollback if $oldAutoCommit;
 537         return $error;
 538       }
 539
 540     }
 541
 542   }
 543
 544   unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
 545     #warn "  queueing fuzzyfiles update\n"
 546     #  if $DEBUG > 1;
 547     $error = $self->queue_fuzzyfiles_update;
 548     if ( $error ) {
 549       $dbh->rollback if $oldAutoCommit;
 550       return "updating fuzzy search cache: $error";
 551     }
 552   }
 553
 554   if ( $cust_contact and (
 555                               (      $cust_contact->selfservice_access eq ''
 556                                   && $link_hash{selfservice_access}
 557                                   && ! length($self->_password)
 558                               )
 559                            || $cust_contact->_resend()
 560                          )
 561     )
 562   {
 563     my $error = $self->send_reset_email( queue=>1 );
 564     if ( $error ) {
 565       $dbh->rollback if $oldAutoCommit;
 566       return $error;
 567     }
 568   }
 569
 570   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 571
 572   '';
 573
 574 }
 575
 576 =item _parse_phonestring PHONENUMBER_STRING
 577
 578 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
 579 with keys 'countrycode', 'phonenum' and 'extension'
 580
 581 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
 582
 583 =cut
 584
 585 sub _parse_phonestring {
 586   my $value = shift;
 587
 588   my($countrycode, $extension) = ('1', '');
 589
 590   #countrycode
 591   if ( $value =~ s/^\s*\+\s*(\d+)// ) {
 592     $countrycode = $1;
 593   } else {
 594     $value =~ s/^\s*1//;
 595   }
 596   #extension
 597   if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
 598      $extension = $2;
 599   }
 600
 601   ( 'countrycode' => $countrycode,
 602     'phonenum'    => $value,
 603     'extension'   => $extension,
 604   );
 605 }
 606
 607 =item queue_fuzzyfiles_update
 608
 609 Used by insert & replace to update the fuzzy search cache
 610
 611 =cut
 612
 613 use FS::cust_main::Search;
 614 sub queue_fuzzyfiles_update {
 615   my $self = shift;
 616
 617   local $SIG{HUP} = 'IGNORE';
 618   local $SIG{INT} = 'IGNORE';
 619   local $SIG{QUIT} = 'IGNORE';
 620   local $SIG{TERM} = 'IGNORE';
 621   local $SIG{TSTP} = 'IGNORE';
 622   local $SIG{PIPE} = 'IGNORE';
 623
 624   my $oldAutoCommit = $FS::UID::AutoCommit;
 625   local $FS::UID::AutoCommit = 0;
 626   my $dbh = dbh;
 627
 628   foreach my $field ( 'first', 'last' ) {
 629     my $queue = new FS::queue {
 630       'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
 631     };
 632     my @args = "contact.$field", $self->get($field);
 633     my $error = $queue->insert( @args );
 634     if ( $error ) {
 635       $dbh->rollback if $oldAutoCommit;
 636       return "queueing job (transaction rolled back): $error";
 637     }
 638   }
 639
 640   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 641   '';
 642
 643 }
 644
 645 =item check
 646
 647 Checks all fields to make sure this is a valid contact.  If there is
 648 an error, returns the error, otherwise returns false.  Called by the insert
 649 and replace methods.
 650
 651 =cut
 652
 653 sub check {
 654   my $self = shift;
 655
 656   if ( $self->selfservice_access eq 'R' ) {
 657     $self->selfservice_access('Y');
 658     $self->_resend('Y');
 659   }
 660
 661   my $error =
 662     $self->ut_numbern('contactnum')
 663     || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
 664     || $self->ut_foreign_keyn('custnum',     'cust_main',     'custnum')
 665     || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
 666     || $self->ut_foreign_keyn('classnum',    'contact_class', 'classnum')
 667     || $self->ut_namen('last')
 668     || $self->ut_namen('first')
 669     || $self->ut_textn('title')
 670     || $self->ut_textn('comment')
 671     || $self->ut_enum('selfservice_access', [ '', 'Y' ])
 672     || $self->ut_textn('_password')
 673     || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
 674     || $self->ut_enum('disabled', [ '', 'Y' ])
 675   ;
 676   return $error if $error;
 677
 678   return "Prospect and customer!"       if $self->prospectnum && $self->custnum;
 679
 680   return "One of first name, last name, or title must have a value"
 681     if ! grep $self->$_(), qw( first last title);
 682
 683   $self->SUPER::check;
 684 }
 685
 686 =item line
 687
 688 Returns a formatted string representing this contact, including name, title and
 689 comment.
 690
 691 =cut
 692
 693 sub line {
 694   my $self = shift;
 695   my $data = $self->first. ' '. $self->last;
 696   $data .= ', '. $self->title
 697     if $self->title;
 698   $data .= ' ('. $self->comment. ')'
 699     if $self->comment;
 700   $data;
 701 }
 702
 703 =item firstlast
 704
 705 Returns a formatted string representing this contact, with just the name.
 706
 707 =cut
 708
 709 sub firstlast {
 710   my $self = shift;
 711   $self->first . ' ' . $self->last;
 712 }
 713
 714 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
 715 #
 716 #Returns the name of this contact's class for the specified prospect or
 717 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
 718 #L<FS::contact_class>).
 719 #
 720 #=cut
 721 #
 722 #sub contact_classname {
 723 #  my( $self, $prospect_or_cust ) = @_;
 724 #
 725 #  my $link = '';
 726 #  if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
 727 #    $link = qsearchs('prospect_contact', {
 728 #              'contactnum'  => $self->contactnum,
 729 #              'prospectnum' => $prospect_or_cust->prospectnum,
 730 #            });
 731 #  } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
 732 #    $link = qsearchs('cust_contact', {
 733 #              'contactnum'  => $self->contactnum,
 734 #              'custnum'     => $prospect_or_cust->custnum,
 735 #            });
 736 #  } else {
 737 #    croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
 738 #  }
 739 #
 740 #  my $contact_class = $link->contact_class or return '';
 741 #  $contact_class->classname;
 742 #}
 743
 744 =item by_selfservice_email EMAILADDRESS
 745
 746 Alternate search constructor (class method).  Given an email address, returns
 747 the contact for that address. If that contact doesn't have selfservice access,
 748 or there isn't one, returns the empty string.
 749
 750 =cut
 751
 752 sub by_selfservice_email {
 753   my($class, $email) = @_;
 754
 755   my $contact_email = qsearchs({
 756     'table'     => 'contact_email',
 757     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 758     'hashref'   => { 'emailaddress' => $email, },
 759     'extra_sql' => " AND ( contact.disabled IS NULL ) ".
 760                    " AND ( contact.selfservice_access = 'Y' )",
 761   }) or return '';
 762
 763   $contact_email->contact;
 764
 765 }
 766
 767 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 768 # and should maybe be libraried in some way for other password needs
 769
 770 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 771
 772 sub authenticate_password {
 773   my($self, $check_password) = @_;
 774
 775   if ( $self->_password_encoding eq 'bcrypt' ) {
 776
 777     my( $cost, $salt, $hash ) = split(',', $self->_password);
 778
 779     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 780                                                cost    => $cost,
 781                                                salt    => de_base64($salt),
 782                                              },
 783                                              $check_password
 784                                            )
 785                               );
 786
 787     $hash eq $check_hash;
 788
 789   } else {
 790
 791     return 0 if $self->_password eq '';
 792
 793     $self->_password eq $check_password;
 794
 795   }
 796
 797 }
 798
 799 =item change_password NEW_PASSWORD
 800
 801 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 802 not check password policy rules (see C<is_password_allowed>) and will return
 803 an error only if editing the record fails for some reason.
 804
 805 If NEW_PASSWORD is the same as the existing password, this does nothing.
 806
 807 =cut
 808
 809 sub change_password {
 810   my($self, $new_password) = @_;
 811
 812   # do nothing if the password is unchanged
 813   return if $self->authenticate_password($new_password);
 814
 815   $self->change_password_fields( $new_password );
 816
 817   $self->replace;
 818
 819 }
 820
 821 sub change_password_fields {
 822   my($self, $new_password) = @_;
 823
 824   $self->_password_encoding('bcrypt');
 825
 826   my $cost = 8;
 827
 828   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 829
 830   my $hash = bcrypt_hash( { key_nul => 1,
 831                             cost    => $cost,
 832                             salt    => $salt,
 833                           },
 834                           $new_password,
 835                         );
 836
 837   $self->_password(
 838     join(',', $cost, en_base64($salt), en_base64($hash) )
 839   );
 840
 841 }
 842
 843 # end of false laziness w/FS/FS/Auth/internal.pm
 844
 845
 846 #false laziness w/ClientAPI/MyAccount/reset_passwd
 847 use Digest::SHA qw(sha512_hex);
 848 use FS::Conf;
 849 use FS::ClientAPI_SessionCache;
 850 sub send_reset_email {
 851   my( $self, %opt ) = @_;
 852
 853   my @contact_email = $self->contact_email or return '';
 854
 855   my $reset_session = {
 856     'contactnum' => $self->contactnum,
 857     'svcnum'     => $opt{'svcnum'},
 858   };
 859
 860   my $timeout = '24 hours'; #?
 861
 862   my $reset_session_id;
 863   do {
 864     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 865   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 866     #just in case
 867
 868   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 869
 870   #email it
 871
 872   my $conf = new FS::Conf;
 873
 874   my $cust_main = '';
 875   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 876   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 877
 878   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 879   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 880   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 881   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 882   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 883   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 884   my %msg_template = (
 885     'to'            => join(',', map $_->emailaddress, @contact_email ),
 886     'cust_main'     => $cust_main,
 887     'object'        => $self,
 888     'substitutions' => { 'session_id' => $reset_session_id }
 889   );
 890
 891   if ( $opt{'queue'} ) { #or should queueing just be the default?
 892
 893     my $cust_msg = $msg_template->prepare( %msg_template );
 894     my $error = $cust_msg->insert;
 895     return $error if $error;
 896     my $queue = new FS::queue {
 897       'job'     => 'FS::cust_msg::process_send',
 898       'custnum' => $cust_main ? $cust_main->custnum : '',
 899     };
 900     $queue->insert( $cust_msg->custmsgnum );
 901
 902   } else {
 903
 904     $msg_template->send( %msg_template );
 905
 906   }
 907
 908 }
 909
 910 use vars qw( $myaccount_cache );
 911 sub myaccount_cache {
 912   #my $class = shift;
 913   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 914                          'namespace' => 'FS::ClientAPI::MyAccount',
 915                        } );
 916 }
 917
 918 =item cgi_contact_fields
 919
 920 Returns a list reference containing the set of contact fields used in the web
 921 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 922 and locationnum, as well as password fields, but including fields for
 923 contact_email and contact_phone records.)
 924
 925 =cut
 926
 927 sub cgi_contact_fields {
 928   #my $class = shift;
 929
 930   my @contact_fields = qw(
 931     classnum first last title comment emailaddress selfservice_access
 932     invoice_dest
 933   );
 934
 935   push @contact_fields, 'phonetypenum'. $_->phonetypenum
 936     foreach qsearch({table=>'phone_type', order_by=>'weight'});
 937
 938   \@contact_fields;
 939
 940 }
 941
 942 use FS::upgrade_journal;
 943 sub _upgrade_data { #class method
 944   my ($class, %opts) = @_;
 945
 946   # always migrate cust_main_invoice records over
 947   local $FS::cust_main::import = 1; # override require_phone and such
 948   my $search = FS::Cursor->new('cust_main_invoice', {});
 949   my %custnum_dest;
 950   while (my $cust_main_invoice = $search->fetch) {
 951     my $custnum = $cust_main_invoice->custnum;
 952     my $dest = $cust_main_invoice->dest;
 953     my $cust_main = $cust_main_invoice->cust_main;
 954
 955     if ( $dest =~ /^\d+$/ ) {
 956       my $svc_acct = FS::svc_acct->by_key($dest);
 957       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
 958         if !$svc_acct;
 959       $dest = $svc_acct->email;
 960     }
 961     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
 962
 963     my $error = $cust_main_invoice->delete;
 964     if ( $error ) {
 965       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
 966     }
 967   }
 968
 969   foreach my $custnum (keys %custnum_dest) {
 970     my $dests = $custnum_dest{$custnum};
 971     my $cust_main = FS::cust_main->by_key($custnum);
 972     my $error = $cust_main->replace( invoicing_list => $dests );
 973     if ( $error ) {
 974       die "custnum $custnum, creating contact: $error\n";
 975     }
 976   }
 977
 978   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
 979
 980     local($skip_fuzzyfiles) = 1;
 981
 982     foreach my $contact (qsearch('contact', {})) {
 983       my $error = $contact->replace;
 984       die $error if $error;
 985     }
 986
 987     FS::upgrade_journal->set_done('contact_invoice_dest');
 988   }
 989
 990 }
 991
 992 =back
 993
 994 =head1 BUGS
 995
 996 =head1 SEE ALSO
 997
 998 L<FS::Record>, schema.html from the base documentation.
 999
1000 =cut
1001
1002 1;
1003