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 #autoloaded by FK in 4.x, but not during the upgrade
 745 sub contact_email {
 746   my $self = shift;
 747   qsearch('contact_email', { 'contactnum' => $self->contactnum } );
 748 }
 749
 750 =item by_selfservice_email EMAILADDRESS
 751
 752 Alternate search constructor (class method).  Given an email address, returns
 753 the contact for that address. If that contact doesn't have selfservice access,
 754 or there isn't one, returns the empty string.
 755
 756 =cut
 757
 758 sub by_selfservice_email {
 759   my($class, $email) = @_;
 760
 761   my $contact_email = qsearchs({
 762     'table'     => 'contact_email',
 763     'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
 764     'hashref'   => { 'emailaddress' => $email, },
 765     'extra_sql' => " AND ( contact.disabled IS NULL ) ".
 766                    " AND ( contact.selfservice_access = 'Y' )",
 767   }) or return '';
 768
 769   $contact_email->contact;
 770
 771 }
 772
 773 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
 774 # and should maybe be libraried in some way for other password needs
 775
 776 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
 777
 778 sub authenticate_password {
 779   my($self, $check_password) = @_;
 780
 781   if ( $self->_password_encoding eq 'bcrypt' ) {
 782
 783     my( $cost, $salt, $hash ) = split(',', $self->_password);
 784
 785     my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
 786                                                cost    => $cost,
 787                                                salt    => de_base64($salt),
 788                                              },
 789                                              $check_password
 790                                            )
 791                               );
 792
 793     $hash eq $check_hash;
 794
 795   } else {
 796
 797     return 0 if $self->_password eq '';
 798
 799     $self->_password eq $check_password;
 800
 801   }
 802
 803 }
 804
 805 =item change_password NEW_PASSWORD
 806
 807 Changes the contact's selfservice access password to NEW_PASSWORD. This does
 808 not check password policy rules (see C<is_password_allowed>) and will return
 809 an error only if editing the record fails for some reason.
 810
 811 If NEW_PASSWORD is the same as the existing password, this does nothing.
 812
 813 =cut
 814
 815 sub change_password {
 816   my($self, $new_password) = @_;
 817
 818   # do nothing if the password is unchanged
 819   return if $self->authenticate_password($new_password);
 820
 821   $self->change_password_fields( $new_password );
 822
 823   $self->replace;
 824
 825 }
 826
 827 sub change_password_fields {
 828   my($self, $new_password) = @_;
 829
 830   $self->_password_encoding('bcrypt');
 831
 832   my $cost = 8;
 833
 834   my $salt = pack( 'C*', map int(rand(256)), 1..16 );
 835
 836   my $hash = bcrypt_hash( { key_nul => 1,
 837                             cost    => $cost,
 838                             salt    => $salt,
 839                           },
 840                           $new_password,
 841                         );
 842
 843   $self->_password(
 844     join(',', $cost, en_base64($salt), en_base64($hash) )
 845   );
 846
 847 }
 848
 849 # end of false laziness w/FS/FS/Auth/internal.pm
 850
 851
 852 #false laziness w/ClientAPI/MyAccount/reset_passwd
 853 use Digest::SHA qw(sha512_hex);
 854 use FS::Conf;
 855 use FS::ClientAPI_SessionCache;
 856 sub send_reset_email {
 857   my( $self, %opt ) = @_;
 858
 859   my @contact_email = $self->contact_email or return '';
 860
 861   my $reset_session = {
 862     'contactnum' => $self->contactnum,
 863     'svcnum'     => $opt{'svcnum'},
 864   };
 865
 866   my $timeout = '24 hours'; #?
 867
 868   my $reset_session_id;
 869   do {
 870     $reset_session_id = sha512_hex(time(). {}. rand(). $$)
 871   } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
 872     #just in case
 873
 874   $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
 875
 876   #email it
 877
 878   my $conf = new FS::Conf;
 879
 880   my $cust_main = '';
 881   my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
 882   $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
 883
 884   my $agentnum = $cust_main ? $cust_main->agentnum : '';
 885   my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
 886   #die "selfservice-password_reset_msgnum unset" unless $msgnum;
 887   return "selfservice-password_reset_msgnum unset" unless $msgnum;
 888   my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
 889   return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
 890   my %msg_template = (
 891     'to'            => join(',', map $_->emailaddress, @contact_email ),
 892     'cust_main'     => $cust_main,
 893     'object'        => $self,
 894     'substitutions' => { 'session_id' => $reset_session_id }
 895   );
 896
 897   if ( $opt{'queue'} ) { #or should queueing just be the default?
 898
 899     my $cust_msg = $msg_template->prepare( %msg_template );
 900     my $error = $cust_msg->insert;
 901     return $error if $error;
 902     my $queue = new FS::queue {
 903       'job'     => 'FS::cust_msg::process_send',
 904       'custnum' => $cust_main ? $cust_main->custnum : '',
 905     };
 906     $queue->insert( $cust_msg->custmsgnum );
 907
 908   } else {
 909
 910     $msg_template->send( %msg_template );
 911
 912   }
 913
 914 }
 915
 916 use vars qw( $myaccount_cache );
 917 sub myaccount_cache {
 918   #my $class = shift;
 919   $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
 920                          'namespace' => 'FS::ClientAPI::MyAccount',
 921                        } );
 922 }
 923
 924 =item cgi_contact_fields
 925
 926 Returns a list reference containing the set of contact fields used in the web
 927 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
 928 and locationnum, as well as password fields, but including fields for
 929 contact_email and contact_phone records.)
 930
 931 =cut
 932
 933 sub cgi_contact_fields {
 934   #my $class = shift;
 935
 936   my @contact_fields = qw(
 937     classnum first last title comment emailaddress selfservice_access
 938     invoice_dest
 939   );
 940
 941   push @contact_fields, 'phonetypenum'. $_->phonetypenum
 942     foreach qsearch({table=>'phone_type', order_by=>'weight'});
 943
 944   \@contact_fields;
 945
 946 }
 947
 948 use FS::upgrade_journal;
 949 sub _upgrade_data { #class method
 950   my ($class, %opts) = @_;
 951
 952   # always migrate cust_main_invoice records over
 953   local $FS::cust_main::import = 1; # override require_phone and such
 954   my $search = FS::Cursor->new('cust_main_invoice', {});
 955   my %custnum_dest;
 956   while (my $cust_main_invoice = $search->fetch) {
 957     my $custnum = $cust_main_invoice->custnum;
 958     my $dest = $cust_main_invoice->dest;
 959     my $cust_main = $cust_main_invoice->cust_main;
 960
 961     if ( $dest =~ /^\d+$/ ) {
 962       my $svc_acct = FS::svc_acct->by_key($dest);
 963       die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
 964         if !$svc_acct;
 965       $dest = $svc_acct->email;
 966     }
 967     push @{ $custnum_dest{$custnum} ||= [] }, $dest;
 968
 969     my $error = $cust_main_invoice->delete;
 970     if ( $error ) {
 971       die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
 972     }
 973   }
 974
 975   foreach my $custnum (keys %custnum_dest) {
 976     my $dests = $custnum_dest{$custnum};
 977     my $cust_main = FS::cust_main->by_key($custnum);
 978     my $error = $cust_main->replace( invoicing_list => $dests );
 979     if ( $error ) {
 980       die "custnum $custnum, creating contact: $error\n";
 981     }
 982   }
 983
 984   unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
 985
 986     local($skip_fuzzyfiles) = 1;
 987
 988     foreach my $contact (qsearch('contact', {})) {
 989       my $error = $contact->replace;
 990       die $error if $error;
 991     }
 992
 993     FS::upgrade_journal->set_done('contact_invoice_dest');
 994   }
 995
 996 }
 997
 998 =back
 999
1000 =head1 BUGS
1001
1002 =head1 SEE ALSO
1003
1004 L<FS::Record>, schema.html from the base documentation.
1005
1006 =cut
1007
1008 1;
1009