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