2 use base qw( FS::Password_Mixin
6 use vars qw( $skip_fuzzyfiles );
8 use Scalar::Util qw( blessed );
9 use FS::Record qw( qsearch qsearchs dbh );
11 use FS::contact_phone;
12 use FS::contact_email;
14 use FS::phone_type; #for cgi_contact_fields
16 use FS::prospect_contact;
22 FS::contact - Object methods for contact records
28 $record = new FS::contact \%hash;
29 $record = new FS::contact { 'column' => 'value' };
31 $error = $record->insert;
33 $error = $new_record->replace($old_record);
35 $error = $record->delete;
37 $error = $record->check;
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
79 =item selfservice_access
85 =item _password_encoding
95 empty, or 'Y' if email invoices should be sent to this contact
105 Creates a new contact. To add the contact to the database, see L<"insert">.
107 Note that this stores the hash reference, not a distinct copy of the hash it
108 points to. You can ask the object for a copy with the I<hash> method.
112 sub table { 'contact'; }
116 Adds this record to the database. If there is an error, returns the error,
117 otherwise returns false.
119 If the object has an C<emailaddress> field, L<FS::contact_email> records will
120 be created for each (comma-separated) email address in that field. If any of
121 these coincide with an existing email address, this contact will be merged with
122 the contact with that address.
124 Then, if the object has any fields named C<phonetypenumN> an
125 L<FS::contact_phone> record will be created for each of them. Those fields
126 should contain phone numbers of the appropriate types (where N is the key of
127 an L<FS::phone_type> record identifying the type of number: daytime, night,
130 After inserting the record, if the object has a 'custnum' or 'prospectnum'
131 field, an L<FS::cust_contact> or L<FS::prospect_contact> record will be
132 created to link the contact to the customer. The following fields will also
133 be included in that record, if they are set on the object:
143 local $SIG{INT} = 'IGNORE';
144 local $SIG{QUIT} = 'IGNORE';
145 local $SIG{TERM} = 'IGNORE';
146 local $SIG{TSTP} = 'IGNORE';
147 local $SIG{PIPE} = 'IGNORE';
149 my $oldAutoCommit = $FS::UID::AutoCommit;
150 local $FS::UID::AutoCommit = 0;
153 #save off and blank values that move to cust_contact / prospect_contact now
154 my $prospectnum = $self->prospectnum;
155 $self->prospectnum('');
156 my $custnum = $self->custnum;
160 for (qw( classnum comment selfservice_access )) {
161 $link_hash{$_} = $self->get($_);
165 #look for an existing contact with this email address
166 my $existing_contact = '';
167 if ( $self->get('emailaddress') =~ /\S/ ) {
169 my %existing_contact = ();
171 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
173 my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
176 my $contact = $contact_email->contact;
177 $existing_contact{ $contact->contactnum } = $contact;
181 if ( scalar( keys %existing_contact ) > 1 ) {
182 $dbh->rollback if $oldAutoCommit;
183 return 'Multiple email addresses specified '.
184 ' that already belong to separate contacts';
185 } elsif ( scalar( keys %existing_contact ) ) {
186 ($existing_contact) = values %existing_contact;
192 if ( $existing_contact ) {
194 $self->$_($existing_contact->$_())
195 for qw( contactnum _password _password_encoding );
196 $error = $self->SUPER::replace($existing_contact);
200 $error = $self->SUPER::insert;
204 $error ||= $self->insert_password_history;
207 $dbh->rollback if $oldAutoCommit;
211 my $cust_contact = '';
213 my %hash = ( 'contactnum' => $self->contactnum,
214 'custnum' => $custnum,
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;
221 $dbh->rollback if $oldAutoCommit;
226 if ( $prospectnum ) {
227 my %hash = ( 'contactnum' => $self->contactnum,
228 'prospectnum' => $prospectnum,
230 my $prospect_contact = qsearchs('prospect_contact', \%hash )
231 || new FS::prospect_contact { %hash, %link_hash };
233 $prospect_contact->prospectcontactnum ? $prospect_contact->replace
234 : $prospect_contact->insert;
236 $dbh->rollback if $oldAutoCommit;
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;
246 my %hash = ( 'contactnum' => $self->contactnum,
247 'phonetypenum' => $phonetypenum,
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;
255 $dbh->rollback if $oldAutoCommit;
260 if ( $self->get('emailaddress') =~ /\S/ ) {
262 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
264 'contactnum' => $self->contactnum,
265 'emailaddress' => $email,
267 unless ( qsearchs('contact_email', \%hash) ) {
268 my $contact_email = new FS::contact_email \%hash;
269 my $error = $contact_email->insert;
271 $dbh->rollback if $oldAutoCommit;
279 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
280 #warn " queueing fuzzyfiles update\n"
282 my $error = $self->queue_fuzzyfiles_update;
284 $dbh->rollback if $oldAutoCommit;
285 return "updating fuzzy search cache: $error";
289 if ( $link_hash{'selfservice_access'} eq 'R'
290 or ( $link_hash{'selfservice_access'}
292 && ! length($self->_password)
296 my $error = $self->send_reset_email( queue=>1 );
298 $dbh->rollback if $oldAutoCommit;
303 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
311 Delete this record from the database.
318 local $SIG{HUP} = 'IGNORE';
319 local $SIG{INT} = 'IGNORE';
320 local $SIG{QUIT} = 'IGNORE';
321 local $SIG{TERM} = 'IGNORE';
322 local $SIG{TSTP} = 'IGNORE';
323 local $SIG{PIPE} = 'IGNORE';
325 my $oldAutoCommit = $FS::UID::AutoCommit;
326 local $FS::UID::AutoCommit = 0;
329 #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
331 if ( $self->prospectnum ) {
332 my $prospect_contact = qsearchs('prospect_contact', {
333 'contactnum' => $self->contactnum,
334 'prospectnum' => $self->prospectnum,
336 my $error = $prospect_contact->delete;
338 $dbh->rollback if $oldAutoCommit;
343 if ( $self->custnum ) {
344 my $cust_contact = qsearchs('cust_contact', {
345 'contactnum' => $self->contactnum,
346 'custnum' => $self->custnum,
348 my $error = $cust_contact->delete;
350 $dbh->rollback if $oldAutoCommit;
355 # then, proceed with deletion only if the contact isn't attached to any other
356 # prospects or customers
358 #inefficient, but how many prospects/customers can a single contact be
359 # attached too? (and is removing them from one a common operation?)
360 if ( $self->prospect_contact || $self->cust_contact ) {
361 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
365 #proceed with deletion
367 foreach my $cust_pkg ( $self->cust_pkg ) {
368 $cust_pkg->contactnum('');
369 my $error = $cust_pkg->replace;
371 $dbh->rollback if $oldAutoCommit;
376 foreach my $object ( $self->contact_phone, $self->contact_email ) {
377 my $error = $object->delete;
379 $dbh->rollback if $oldAutoCommit;
384 my $error = $self->SUPER::delete;
386 $dbh->rollback if $oldAutoCommit;
390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
395 =item replace OLD_RECORD
397 Replaces the OLD_RECORD with this one in the database. If there is an error,
398 returns the error, otherwise returns false.
405 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
407 : $self->replace_old;
409 $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
411 local $SIG{INT} = 'IGNORE';
412 local $SIG{QUIT} = 'IGNORE';
413 local $SIG{TERM} = 'IGNORE';
414 local $SIG{TSTP} = 'IGNORE';
415 local $SIG{PIPE} = 'IGNORE';
417 my $oldAutoCommit = $FS::UID::AutoCommit;
418 local $FS::UID::AutoCommit = 0;
421 #save off and blank values that move to cust_contact / prospect_contact now
422 my $prospectnum = $self->prospectnum;
423 $self->prospectnum('');
424 my $custnum = $self->custnum;
428 for (qw( classnum comment selfservice_access )) {
429 $link_hash{$_} = $self->get($_);
433 my $error = $self->SUPER::replace($old);
434 if ( $old->_password ne $self->_password ) {
435 $error ||= $self->insert_password_history;
438 $dbh->rollback if $oldAutoCommit;
442 my $cust_contact = '';
444 my %hash = ( 'contactnum' => $self->contactnum,
445 'custnum' => $custnum,
448 if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
449 $cust_contact->$_($link_hash{$_}) for keys %link_hash;
450 $error = $cust_contact->replace;
452 $cust_contact = new FS::cust_contact { %hash, %link_hash };
453 $error = $cust_contact->insert;
456 $dbh->rollback if $oldAutoCommit;
461 if ( $prospectnum ) {
462 my %hash = ( 'contactnum' => $self->contactnum,
463 'prospectnum' => $prospectnum,
466 if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
467 $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
468 $error = $prospect_contact->replace;
470 my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
471 $error = $prospect_contact->insert;
474 $dbh->rollback if $oldAutoCommit;
479 foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
480 keys %{ $self->hashref } ) {
481 $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
482 my $phonetypenum = $1;
484 my %cp = ( 'contactnum' => $self->contactnum,
485 'phonetypenum' => $phonetypenum,
487 my $contact_phone = qsearchs('contact_phone', \%cp);
489 my $pv = $self->get($pf);
492 #if new value is empty, delete old entry
494 if ($contact_phone) {
495 $error = $contact_phone->delete;
497 $dbh->rollback if $oldAutoCommit;
504 $contact_phone ||= new FS::contact_phone \%cp;
506 my %cpd = _parse_phonestring( $pv );
507 $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
509 my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
511 $error = $contact_phone->$method;
513 $dbh->rollback if $oldAutoCommit;
518 if ( defined($self->hashref->{'emailaddress'}) ) {
520 #ineffecient but whatever, how many email addresses can there be?
522 foreach my $contact_email ( $self->contact_email ) {
523 my $error = $contact_email->delete;
525 $dbh->rollback if $oldAutoCommit;
530 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
532 my $contact_email = new FS::contact_email {
533 'contactnum' => $self->contactnum,
534 'emailaddress' => $email,
536 $error = $contact_email->insert;
538 $dbh->rollback if $oldAutoCommit;
546 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
547 #warn " queueing fuzzyfiles update\n"
549 $error = $self->queue_fuzzyfiles_update;
551 $dbh->rollback if $oldAutoCommit;
552 return "updating fuzzy search cache: $error";
556 if ( $cust_contact and (
557 ( $cust_contact->selfservice_access eq ''
558 && $link_hash{selfservice_access}
559 && ! length($self->_password)
561 || $cust_contact->_resend()
565 my $error = $self->send_reset_email( queue=>1 );
567 $dbh->rollback if $oldAutoCommit;
572 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
578 =item _parse_phonestring PHONENUMBER_STRING
580 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
581 with keys 'countrycode', 'phonenum' and 'extension'
583 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
587 sub _parse_phonestring {
590 my($countrycode, $extension) = ('1', '');
593 if ( $value =~ s/^\s*\+\s*(\d+)// ) {
599 if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
603 ( 'countrycode' => $countrycode,
604 'phonenum' => $value,
605 'extension' => $extension,
609 =item queue_fuzzyfiles_update
611 Used by insert & replace to update the fuzzy search cache
615 use FS::cust_main::Search;
616 sub queue_fuzzyfiles_update {
619 local $SIG{HUP} = 'IGNORE';
620 local $SIG{INT} = 'IGNORE';
621 local $SIG{QUIT} = 'IGNORE';
622 local $SIG{TERM} = 'IGNORE';
623 local $SIG{TSTP} = 'IGNORE';
624 local $SIG{PIPE} = 'IGNORE';
626 my $oldAutoCommit = $FS::UID::AutoCommit;
627 local $FS::UID::AutoCommit = 0;
630 foreach my $field ( 'first', 'last' ) {
631 my $queue = new FS::queue {
632 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
634 my @args = "contact.$field", $self->get($field);
635 my $error = $queue->insert( @args );
637 $dbh->rollback if $oldAutoCommit;
638 return "queueing job (transaction rolled back): $error";
642 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
649 Checks all fields to make sure this is a valid contact. If there is
650 an error, returns the error, otherwise returns false. Called by the insert
658 if ( $self->selfservice_access eq 'R' ) {
659 $self->selfservice_access('Y');
664 $self->ut_numbern('contactnum')
665 || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
666 || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
667 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
668 || $self->ut_foreign_keyn('classnum', 'contact_class', 'classnum')
669 || $self->ut_namen('last')
670 || $self->ut_namen('first')
671 || $self->ut_textn('title')
672 || $self->ut_textn('comment')
673 || $self->ut_enum('selfservice_access', [ '', 'Y' ])
674 || $self->ut_textn('_password')
675 || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
676 || $self->ut_enum('disabled', [ '', 'Y' ])
677 || $self->ut_flag('invoice_dest')
679 return $error if $error;
681 return "Prospect and customer!" if $self->prospectnum && $self->custnum;
683 return "One of first name, last name, or title must have a value"
684 if ! grep $self->$_(), qw( first last title);
691 Returns a formatted string representing this contact, including name, title and
698 my $data = $self->first. ' '. $self->last;
699 $data .= ', '. $self->title
701 $data .= ' ('. $self->comment. ')'
708 Returns a formatted string representing this contact, with just the name.
714 $self->first . ' ' . $self->last;
717 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
719 #Returns the name of this contact's class for the specified prospect or
720 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
721 #L<FS::contact_class>).
725 #sub contact_classname {
726 # my( $self, $prospect_or_cust ) = @_;
729 # if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
730 # $link = qsearchs('prospect_contact', {
731 # 'contactnum' => $self->contactnum,
732 # 'prospectnum' => $prospect_or_cust->prospectnum,
734 # } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
735 # $link = qsearchs('cust_contact', {
736 # 'contactnum' => $self->contactnum,
737 # 'custnum' => $prospect_or_cust->custnum,
740 # croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
743 # my $contact_class = $link->contact_class or return '';
744 # $contact_class->classname;
747 =item by_selfservice_email EMAILADDRESS
749 Alternate search constructor (class method). Given an email address,
750 returns the contact for that address, or the empty string if no contact
751 has that email address.
755 sub by_selfservice_email {
756 my($class, $email) = @_;
758 my $contact_email = qsearchs({
759 'table' => 'contact_email',
760 'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
761 'hashref' => { 'emailaddress' => $email, },
762 'extra_sql' => " AND ( disabled IS NULL OR disabled = '' )",
765 $contact_email->contact;
769 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
770 # and should maybe be libraried in some way for other password needs
772 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
774 sub authenticate_password {
775 my($self, $check_password) = @_;
777 if ( $self->_password_encoding eq 'bcrypt' ) {
779 my( $cost, $salt, $hash ) = split(',', $self->_password);
781 my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
783 salt => de_base64($salt),
789 $hash eq $check_hash;
793 return 0 if $self->_password eq '';
795 $self->_password eq $check_password;
801 =item change_password NEW_PASSWORD
803 Changes the contact's selfservice access password to NEW_PASSWORD. This does
804 not check password policy rules (see C<is_password_allowed>) and will return
805 an error only if editing the record fails for some reason.
807 If NEW_PASSWORD is the same as the existing password, this does nothing.
811 sub change_password {
812 my($self, $new_password) = @_;
814 # do nothing if the password is unchanged
815 return if $self->authenticate_password($new_password);
817 $self->change_password_fields( $new_password );
823 sub change_password_fields {
824 my($self, $new_password) = @_;
826 $self->_password_encoding('bcrypt');
830 my $salt = pack( 'C*', map int(rand(256)), 1..16 );
832 my $hash = bcrypt_hash( { key_nul => 1,
840 join(',', $cost, en_base64($salt), en_base64($hash) )
845 # end of false laziness w/FS/FS/Auth/internal.pm
848 #false laziness w/ClientAPI/MyAccount/reset_passwd
849 use Digest::SHA qw(sha512_hex);
851 use FS::ClientAPI_SessionCache;
852 sub send_reset_email {
853 my( $self, %opt ) = @_;
855 my @contact_email = $self->contact_email or return '';
857 my $reset_session = {
858 'contactnum' => $self->contactnum,
859 'svcnum' => $opt{'svcnum'},
862 my $timeout = '24 hours'; #?
864 my $reset_session_id;
866 $reset_session_id = sha512_hex(time(). {}. rand(). $$)
867 } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
870 $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
874 my $conf = new FS::Conf;
877 my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
878 $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
880 my $agentnum = $cust_main ? $cust_main->agentnum : '';
881 my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
882 #die "selfservice-password_reset_msgnum unset" unless $msgnum;
883 return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
884 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
885 return { 'error' => "selfservice-password_reset_msgnum cannot be loaded" } unless $msg_template;
887 'to' => join(',', map $_->emailaddress, @contact_email ),
888 'cust_main' => $cust_main,
890 'substitutions' => { 'session_id' => $reset_session_id }
893 if ( $opt{'queue'} ) { #or should queueing just be the default?
895 my $cust_msg = $msg_template->prepare( %msg_template );
896 my $error = $cust_msg->insert;
897 return { 'error' => $error } if $error;
898 my $queue = new FS::queue {
899 'job' => 'FS::cust_msg::process_send',
900 'custnum' => $cust_main ? $cust_main->custnum : '',
902 $queue->insert( $cust_msg->custmsgnum );
906 $msg_template->send( %msg_template );
912 use vars qw( $myaccount_cache );
913 sub myaccount_cache {
915 $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
916 'namespace' => 'FS::ClientAPI::MyAccount',
920 =item cgi_contact_fields
922 Returns a list reference containing the set of contact fields used in the web
923 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
924 and locationnum, as well as password fields, but including fields for
925 contact_email and contact_phone records.)
929 sub cgi_contact_fields {
932 my @contact_fields = qw(
933 classnum first last title comment emailaddress selfservice_access
937 push @contact_fields, 'phonetypenum'. $_->phonetypenum
938 foreach qsearch({table=>'phone_type', order_by=>'weight'});
944 use FS::upgrade_journal;
945 sub _upgrade_data { #class method
946 my ($class, %opts) = @_;
948 # always migrate cust_main_invoice records over
949 local $FS::cust_main::import = 1; # override require_phone and such
950 my $search = FS::Cursor->new('cust_main_invoice', {});
951 while (my $cust_main_invoice = $search->fetch) {
952 my $custnum = $cust_main_invoice->custnum;
953 my $dest = $cust_main_invoice->dest;
954 my $cust_main = $cust_main_invoice->cust_main;
956 if ( $dest =~ /^\d+$/ ) {
957 my $svc_acct = FS::svc_acct->by_key($dest);
958 die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
960 $dest = $svc_acct->email;
963 my $error = $cust_main->replace( [ $dest ] );
966 die "custnum $custnum, invoice destination $dest, creating contact: $error\n";
969 $error = $cust_main_invoice->delete;
970 die "custnum $custnum, cleaning up cust_main_invoice: $error\n" if $error;
972 } # while $search->fetch
974 unless ( FS::upgrade_journal->is_done('contact__DUPEMAIL') ) {
976 foreach my $contact (qsearch('contact', {})) {
977 my $error = $contact->replace;
978 die $error if $error;
981 FS::upgrade_journal->set_done('contact__DUPEMAIL');
992 L<FS::Record>, schema.html from the base documentation.