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
101 Creates a new contact. To add the contact to the database, see L<"insert">.
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.
108 sub table { 'contact'; }
112 Adds this record to the database. If there is an error, returns the error,
113 otherwise returns false.
115 If the object has an C<emailaddress> field, L<FS::contact_email> records
116 will be created for each (comma-separated) email address in that field. If
117 any of these coincide with an existing email address, this contact will be
118 merged with the contact with that address.
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,
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:
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';
146 my $oldAutoCommit = $FS::UID::AutoCommit;
147 local $FS::UID::AutoCommit = 0;
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;
157 for (qw( classnum comment selfservice_access invoice_dest )) {
158 $link_hash{$_} = $self->get($_);
162 #look for an existing contact with this email address
163 my $existing_contact = '';
164 if ( $self->get('emailaddress') =~ /\S/ ) {
166 my %existing_contact = ();
168 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
170 my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
173 my $contact = $contact_email->contact;
174 $existing_contact{ $contact->contactnum } = $contact;
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;
189 if ( $existing_contact ) {
191 $self->$_($existing_contact->$_())
192 for qw( contactnum _password _password_encoding );
193 $error = $self->SUPER::replace($existing_contact);
197 $error = $self->SUPER::insert;
201 $error ||= $self->insert_password_history;
204 $dbh->rollback if $oldAutoCommit;
208 my $cust_contact = '';
209 # if $self->custnum was set, then the customer-specific properties
210 # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
211 # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
214 my %hash = ( 'contactnum' => $self->contactnum,
215 'custnum' => $custnum,
217 $cust_contact = qsearchs('cust_contact', \%hash )
218 || new FS::cust_contact { %hash, %link_hash };
219 my $error = $cust_contact->custcontactnum ? $cust_contact->replace
220 : $cust_contact->insert;
222 $dbh->rollback if $oldAutoCommit;
227 if ( $prospectnum ) {
228 my %hash = ( 'contactnum' => $self->contactnum,
229 'prospectnum' => $prospectnum,
231 my $prospect_contact = qsearchs('prospect_contact', \%hash )
232 || new FS::prospect_contact { %hash, %link_hash };
234 $prospect_contact->prospectcontactnum ? $prospect_contact->replace
235 : $prospect_contact->insert;
237 $dbh->rollback if $oldAutoCommit;
242 foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
243 keys %{ $self->hashref } ) {
244 $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
245 my $phonetypenum = $1;
247 my %hash = ( 'contactnum' => $self->contactnum,
248 'phonetypenum' => $phonetypenum,
251 qsearchs('contact_phone', \%hash)
252 || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
253 my $error = $contact_phone->contactphonenum ? $contact_phone->replace
254 : $contact_phone->insert;
256 $dbh->rollback if $oldAutoCommit;
261 if ( $self->get('emailaddress') =~ /\S/ ) {
263 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
265 'contactnum' => $self->contactnum,
266 'emailaddress' => $email,
268 unless ( qsearchs('contact_email', \%hash) ) {
269 my $contact_email = new FS::contact_email \%hash;
270 my $error = $contact_email->insert;
272 $dbh->rollback if $oldAutoCommit;
280 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
281 #warn " queueing fuzzyfiles update\n"
283 my $error = $self->queue_fuzzyfiles_update;
285 $dbh->rollback if $oldAutoCommit;
286 return "updating fuzzy search cache: $error";
290 if ( $link_hash{'selfservice_access'} eq 'R'
291 or ( $link_hash{'selfservice_access'}
293 && ! length($self->_password)
297 my $error = $self->send_reset_email( queue=>1 );
299 $dbh->rollback if $oldAutoCommit;
304 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
312 Delete this record from the database.
319 local $SIG{HUP} = 'IGNORE';
320 local $SIG{INT} = 'IGNORE';
321 local $SIG{QUIT} = 'IGNORE';
322 local $SIG{TERM} = 'IGNORE';
323 local $SIG{TSTP} = 'IGNORE';
324 local $SIG{PIPE} = 'IGNORE';
326 my $oldAutoCommit = $FS::UID::AutoCommit;
327 local $FS::UID::AutoCommit = 0;
330 #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
332 if ( $self->prospectnum ) {
333 my $prospect_contact = qsearchs('prospect_contact', {
334 'contactnum' => $self->contactnum,
335 'prospectnum' => $self->prospectnum,
337 my $error = $prospect_contact->delete;
339 $dbh->rollback if $oldAutoCommit;
344 # if $self->custnum was set, then we're removing the contact from this
346 if ( $self->custnum ) {
347 my $cust_contact = qsearchs('cust_contact', {
348 'contactnum' => $self->contactnum,
349 'custnum' => $self->custnum,
351 my $error = $cust_contact->delete;
353 $dbh->rollback if $oldAutoCommit;
358 # then, proceed with deletion only if the contact isn't attached to any other
359 # prospects or customers
361 #inefficient, but how many prospects/customers can a single contact be
362 # attached too? (and is removing them from one a common operation?)
363 if ( $self->prospect_contact || $self->cust_contact ) {
364 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
368 #proceed with deletion
370 foreach my $cust_pkg ( $self->cust_pkg ) {
371 $cust_pkg->contactnum('');
372 my $error = $cust_pkg->replace;
374 $dbh->rollback if $oldAutoCommit;
379 foreach my $object ( $self->contact_phone, $self->contact_email ) {
380 my $error = $object->delete;
382 $dbh->rollback if $oldAutoCommit;
387 my $error = $self->delete_password_history
388 || $self->SUPER::delete;
390 $dbh->rollback if $oldAutoCommit;
394 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
399 =item replace OLD_RECORD
401 Replaces the OLD_RECORD with this one in the database. If there is an error,
402 returns the error, otherwise returns false.
409 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
411 : $self->replace_old;
413 $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
415 local $SIG{INT} = 'IGNORE';
416 local $SIG{QUIT} = 'IGNORE';
417 local $SIG{TERM} = 'IGNORE';
418 local $SIG{TSTP} = 'IGNORE';
419 local $SIG{PIPE} = 'IGNORE';
421 my $oldAutoCommit = $FS::UID::AutoCommit;
422 local $FS::UID::AutoCommit = 0;
425 #save off and blank values that move to cust_contact / prospect_contact now
426 my $prospectnum = $self->prospectnum;
427 $self->prospectnum('');
428 my $custnum = $self->custnum;
432 for (qw( classnum comment selfservice_access invoice_dest )) {
433 $link_hash{$_} = $self->get($_);
437 my $error = $self->SUPER::replace($old);
438 if ( $old->_password ne $self->_password ) {
439 $error ||= $self->insert_password_history;
442 $dbh->rollback if $oldAutoCommit;
446 my $cust_contact = '';
447 # if $self->custnum was set, then the customer-specific properties
448 # (custnum, classnum, invoice_dest, selfservice_access, comment) are in
449 # pseudo-fields, and are now in %link_hash. otherwise, ignore all those
452 my %hash = ( 'contactnum' => $self->contactnum,
453 'custnum' => $custnum,
456 if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
457 $cust_contact->$_($link_hash{$_}) for keys %link_hash;
458 $error = $cust_contact->replace;
460 $cust_contact = new FS::cust_contact { %hash, %link_hash };
461 $error = $cust_contact->insert;
464 $dbh->rollback if $oldAutoCommit;
469 if ( $prospectnum ) {
470 my %hash = ( 'contactnum' => $self->contactnum,
471 'prospectnum' => $prospectnum,
474 if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
475 $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
476 $error = $prospect_contact->replace;
478 my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
479 $error = $prospect_contact->insert;
482 $dbh->rollback if $oldAutoCommit;
487 foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
488 keys %{ $self->hashref } ) {
489 $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
490 my $phonetypenum = $1;
492 my %cp = ( 'contactnum' => $self->contactnum,
493 'phonetypenum' => $phonetypenum,
495 my $contact_phone = qsearchs('contact_phone', \%cp);
497 my $pv = $self->get($pf);
500 #if new value is empty, delete old entry
502 if ($contact_phone) {
503 $error = $contact_phone->delete;
505 $dbh->rollback if $oldAutoCommit;
512 $contact_phone ||= new FS::contact_phone \%cp;
514 my %cpd = _parse_phonestring( $pv );
515 $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
517 my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
519 $error = $contact_phone->$method;
521 $dbh->rollback if $oldAutoCommit;
526 if ( defined($self->hashref->{'emailaddress'}) ) {
528 #ineffecient but whatever, how many email addresses can there be?
530 foreach my $contact_email ( $self->contact_email ) {
531 my $error = $contact_email->delete;
533 $dbh->rollback if $oldAutoCommit;
538 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
540 my $contact_email = new FS::contact_email {
541 'contactnum' => $self->contactnum,
542 'emailaddress' => $email,
544 $error = $contact_email->insert;
546 $dbh->rollback if $oldAutoCommit;
554 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
555 #warn " queueing fuzzyfiles update\n"
557 $error = $self->queue_fuzzyfiles_update;
559 $dbh->rollback if $oldAutoCommit;
560 return "updating fuzzy search cache: $error";
564 if ( $cust_contact and (
565 ( $cust_contact->selfservice_access eq ''
566 && $link_hash{selfservice_access}
567 && ! length($self->_password)
569 || $cust_contact->_resend()
573 my $error = $self->send_reset_email( queue=>1 );
575 $dbh->rollback if $oldAutoCommit;
580 if ( $self->get('password') ) {
581 my $error = $self->is_password_allowed($self->get('password'))
582 || $self->change_password($self->get('password'));
584 $dbh->rollback if $oldAutoCommit;
589 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
595 =item _parse_phonestring PHONENUMBER_STRING
597 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
598 with keys 'countrycode', 'phonenum' and 'extension'
600 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
604 sub _parse_phonestring {
607 my($countrycode, $extension) = ('1', '');
610 if ( $value =~ s/^\s*\+\s*(\d+)// ) {
616 if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
620 ( 'countrycode' => $countrycode,
621 'phonenum' => $value,
622 'extension' => $extension,
626 =item queue_fuzzyfiles_update
628 Used by insert & replace to update the fuzzy search cache
632 use FS::cust_main::Search;
633 sub queue_fuzzyfiles_update {
636 local $SIG{HUP} = 'IGNORE';
637 local $SIG{INT} = 'IGNORE';
638 local $SIG{QUIT} = 'IGNORE';
639 local $SIG{TERM} = 'IGNORE';
640 local $SIG{TSTP} = 'IGNORE';
641 local $SIG{PIPE} = 'IGNORE';
643 my $oldAutoCommit = $FS::UID::AutoCommit;
644 local $FS::UID::AutoCommit = 0;
647 foreach my $field ( 'first', 'last' ) {
648 my $queue = new FS::queue {
649 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
651 my @args = "contact.$field", $self->get($field);
652 my $error = $queue->insert( @args );
654 $dbh->rollback if $oldAutoCommit;
655 return "queueing job (transaction rolled back): $error";
659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
666 Checks all fields to make sure this is a valid contact. If there is
667 an error, returns the error, otherwise returns false. Called by the insert
675 if ( $self->selfservice_access eq 'R' || $self->selfservice_access eq 'P' ) {
676 $self->selfservice_access('Y');
681 $self->ut_numbern('contactnum')
682 || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
683 || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
684 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
685 || $self->ut_foreign_keyn('classnum', 'contact_class', 'classnum')
686 || $self->ut_namen('last')
687 || $self->ut_namen('first')
688 || $self->ut_textn('title')
689 || $self->ut_textn('comment')
690 || $self->ut_enum('selfservice_access', [ '', 'Y' ])
691 || $self->ut_textn('_password')
692 || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
693 || $self->ut_enum('disabled', [ '', 'Y' ])
695 return $error if $error;
697 return "Prospect and customer!" if $self->prospectnum && $self->custnum;
699 return "One of first name, last name, or title must have a value"
700 if ! grep $self->$_(), qw( first last title);
707 Returns a formatted string representing this contact, including name, title and
714 my $data = $self->first. ' '. $self->last;
715 $data .= ', '. $self->title
717 $data .= ' ('. $self->comment. ')'
724 Returns a formatted string representing this contact, with just the name.
730 $self->first . ' ' . $self->last;
733 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
735 #Returns the name of this contact's class for the specified prospect or
736 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
737 #L<FS::contact_class>).
741 #sub contact_classname {
742 # my( $self, $prospect_or_cust ) = @_;
745 # if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
746 # $link = qsearchs('prospect_contact', {
747 # 'contactnum' => $self->contactnum,
748 # 'prospectnum' => $prospect_or_cust->prospectnum,
750 # } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
751 # $link = qsearchs('cust_contact', {
752 # 'contactnum' => $self->contactnum,
753 # 'custnum' => $prospect_or_cust->custnum,
756 # croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
759 # my $contact_class = $link->contact_class or return '';
760 # $contact_class->classname;
763 #autoloaded by FK in 4.x, but not during the upgrade
766 qsearch('contact_email', { 'contactnum' => $self->contactnum } );
769 =item by_selfservice_email EMAILADDRESS
771 Alternate search constructor (class method). Given an email address, returns
772 the contact for that address. If that contact doesn't have selfservice access,
773 or there isn't one, returns the empty string.
777 sub by_selfservice_email {
778 my($class, $email) = @_;
780 my $contact_email = qsearchs({
781 'table' => 'contact_email',
782 'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
783 'hashref' => { 'emailaddress' => $email, },
785 AND ( contact.disabled IS NULL )
786 AND EXISTS ( SELECT 1 FROM cust_contact
787 WHERE contact.contactnum = cust_contact.contactnum
788 AND cust_contact.selfservice_access = 'Y'
793 $contact_email->contact;
797 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
798 # and should maybe be libraried in some way for other password needs
800 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
802 sub authenticate_password {
803 my($self, $check_password) = @_;
805 if ( $self->_password_encoding eq 'bcrypt' ) {
807 my( $cost, $salt, $hash ) = split(',', $self->_password);
809 my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
811 salt => de_base64($salt),
817 $hash eq $check_hash;
821 return 0 if $self->_password eq '';
823 $self->_password eq $check_password;
829 =item change_password NEW_PASSWORD
831 Changes the contact's selfservice access password to NEW_PASSWORD. This does
832 not check password policy rules (see C<is_password_allowed>) and will return
833 an error only if editing the record fails for some reason.
835 If NEW_PASSWORD is the same as the existing password, this does nothing.
839 sub change_password {
840 my($self, $new_password) = @_;
842 # do nothing if the password is unchanged
843 return if $self->authenticate_password($new_password);
845 $self->change_password_fields( $new_password );
851 sub change_password_fields {
852 my($self, $new_password) = @_;
854 $self->_password_encoding('bcrypt');
858 my $salt = pack( 'C*', map int(rand(256)), 1..16 );
860 my $hash = bcrypt_hash( { key_nul => 1,
868 join(',', $cost, en_base64($salt), en_base64($hash) )
873 # end of false laziness w/FS/FS/Auth/internal.pm
876 #false laziness w/ClientAPI/MyAccount/reset_passwd
877 use Digest::SHA qw(sha512_hex);
879 use FS::ClientAPI_SessionCache;
880 sub send_reset_email {
881 my( $self, %opt ) = @_;
883 my @contact_email = $self->contact_email or return '';
885 my $reset_session = {
886 'contactnum' => $self->contactnum,
887 'svcnum' => $opt{'svcnum'},
891 my $conf = new FS::Conf;
893 ($conf->config('selfservice-password_reset_hours') || 24 ). ' hours';
895 my $reset_session_id;
897 $reset_session_id = sha512_hex(time(). {}. rand(). $$)
898 } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
901 $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
906 my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
907 $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
909 my $agentnum = $cust_main ? $cust_main->agentnum : '';
910 my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
911 #die "selfservice-password_reset_msgnum unset" unless $msgnum;
912 return "selfservice-password_reset_msgnum unset" unless $msgnum;
913 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
914 return "selfservice-password_reset_msgnum cannot be loaded" unless $msg_template;
916 'to' => join(',', map $_->emailaddress, @contact_email ),
917 'cust_main' => $cust_main,
919 'substitutions' => { 'session_id' => $reset_session_id }
922 if ( $opt{'queue'} ) { #or should queueing just be the default?
924 my $cust_msg = $msg_template->prepare( %msg_template );
925 my $error = $cust_msg->insert;
926 return $error if $error;
927 my $queue = new FS::queue {
928 'job' => 'FS::cust_msg::process_send',
929 'custnum' => $cust_main ? $cust_main->custnum : '',
931 $queue->insert( $cust_msg->custmsgnum );
935 $msg_template->send( %msg_template );
941 use vars qw( $myaccount_cache );
942 sub myaccount_cache {
944 $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
945 'namespace' => 'FS::ClientAPI::MyAccount',
949 =item cgi_contact_fields
951 Returns a list reference containing the set of contact fields used in the web
952 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
953 and locationnum, as well as password fields, but including fields for
954 contact_email and contact_phone records.)
958 sub cgi_contact_fields {
961 my @contact_fields = qw(
962 classnum first last title comment emailaddress selfservice_access
963 invoice_dest password
966 push @contact_fields, 'phonetypenum'. $_->phonetypenum
967 foreach qsearch({table=>'phone_type', order_by=>'weight'});
973 use FS::upgrade_journal;
974 sub _upgrade_data { #class method
975 my ($class, %opts) = @_;
977 # before anything else, migrate contact.custnum to cust_contact records
978 unless ( FS::upgrade_journal->is_done('contact_invoice_dest') ) {
980 local($skip_fuzzyfiles) = 1;
982 foreach my $contact (qsearch('contact', {})) {
983 my $error = $contact->replace;
984 die $error if $error;
987 FS::upgrade_journal->set_done('contact_invoice_dest');
991 # always migrate cust_main_invoice records over
992 local $FS::cust_main::import = 1; # override require_phone and such
993 my $search = FS::Cursor->new('cust_main_invoice', {});
995 while (my $cust_main_invoice = $search->fetch) {
996 my $custnum = $cust_main_invoice->custnum;
997 my $dest = $cust_main_invoice->dest;
998 my $cust_main = $cust_main_invoice->cust_main;
1000 if ( $dest =~ /^\d+$/ ) {
1001 my $svc_acct = FS::svc_acct->by_key($dest);
1002 die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
1004 $dest = $svc_acct->email;
1006 push @{ $custnum_dest{$custnum} ||= [] }, $dest;
1008 my $error = $cust_main_invoice->delete;
1010 die "custnum $custnum, cleaning up cust_main_invoice: $error\n";
1014 foreach my $custnum (keys %custnum_dest) {
1015 my $dests = $custnum_dest{$custnum};
1016 my $cust_main = FS::cust_main->by_key($custnum);
1017 my $error = $cust_main->replace( invoicing_list => $dests );
1019 die "custnum $custnum, creating contact: $error\n";
1031 L<FS::Record>, schema.html from the base documentation.