2 use base qw( FS::Record );
5 use vars qw( $skip_fuzzyfiles );
7 use Scalar::Util qw( blessed );
8 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::contact_phone;
11 use FS::contact_email;
13 use FS::phone_type; #for cgi_contact_fields
15 use FS::prospect_contact;
21 FS::contact - Object methods for contact records
27 $record = new FS::contact \%hash;
28 $record = new FS::contact { 'column' => 'value' };
30 $error = $record->insert;
32 $error = $new_record->replace($old_record);
34 $error = $record->delete;
36 $error = $record->check;
40 An FS::contact object represents an specific contact person for a prospect or
41 customer. FS::contact inherits from FS::Record. The following fields are
78 =item selfservice_access
84 =item _password_encoding
94 empty, or 'Y' if email invoices should be sent to this contact
104 Creates a new contact. To add the contact to the database, see L<"insert">.
106 Note that this stores the hash reference, not a distinct copy of the hash it
107 points to. You can ask the object for a copy with the I<hash> method.
111 sub table { 'contact'; }
115 Adds this record to the database. If there is an error, returns the error,
116 otherwise returns false.
118 If the object has an C<emailaddress> field, L<FS::contact_email> records will
119 be created for each (comma-separated) email address in that field. If any of
120 these coincide with an existing email address, this contact will be merged with
121 the contact with that address.
123 Then, if the object has any fields named C<phonetypenumN> an
124 L<FS::contact_phone> record will be created for each of them. Those fields
125 should contain phone numbers of the appropriate types (where N is the key of
126 an L<FS::phone_type> record identifying the type of number: daytime, night,
129 After inserting the record, if the object has a 'custnum' or 'prospectnum'
130 field, an L<FS::cust_contact> or L<FS::prospect_contact> record will be
131 created to link the contact to the customer. The following fields will also
132 be included in that record, if they are set on the object:
142 local $SIG{INT} = 'IGNORE';
143 local $SIG{QUIT} = 'IGNORE';
144 local $SIG{TERM} = 'IGNORE';
145 local $SIG{TSTP} = 'IGNORE';
146 local $SIG{PIPE} = 'IGNORE';
148 my $oldAutoCommit = $FS::UID::AutoCommit;
149 local $FS::UID::AutoCommit = 0;
152 #save off and blank values that move to cust_contact / prospect_contact now
153 my $prospectnum = $self->prospectnum;
154 $self->prospectnum('');
155 my $custnum = $self->custnum;
159 for (qw( classnum comment selfservice_access )) {
160 $link_hash{$_} = $self->get($_);
164 #look for an existing contact with this email address
165 my $existing_contact = '';
166 if ( $self->get('emailaddress') =~ /\S/ ) {
168 my %existing_contact = ();
170 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
172 my $contact_email = qsearchs('contact_email', { emailaddress=>$email } )
175 my $contact = $contact_email->contact;
176 $existing_contact{ $contact->contactnum } = $contact;
180 if ( scalar( keys %existing_contact ) > 1 ) {
181 $dbh->rollback if $oldAutoCommit;
182 return 'Multiple email addresses specified '.
183 ' that already belong to separate contacts';
184 } elsif ( scalar( keys %existing_contact ) ) {
185 ($existing_contact) = values %existing_contact;
190 if ( $existing_contact ) {
192 $self->$_($existing_contact->$_())
193 for qw( contactnum _password _password_encoding );
194 $self->SUPER::replace($existing_contact);
198 my $error = $self->SUPER::insert;
200 $dbh->rollback if $oldAutoCommit;
206 my $cust_contact = '';
208 my %hash = ( 'contactnum' => $self->contactnum,
209 'custnum' => $custnum,
211 $cust_contact = qsearchs('cust_contact', \%hash )
212 || new FS::cust_contact { %hash, %link_hash };
213 my $error = $cust_contact->custcontactnum ? $cust_contact->replace
214 : $cust_contact->insert;
216 $dbh->rollback if $oldAutoCommit;
221 if ( $prospectnum ) {
222 my %hash = ( 'contactnum' => $self->contactnum,
223 'prospectnum' => $prospectnum,
225 my $prospect_contact = qsearchs('prospect_contact', \%hash )
226 || new FS::prospect_contact { %hash, %link_hash };
228 $prospect_contact->prospectcontactnum ? $prospect_contact->replace
229 : $prospect_contact->insert;
231 $dbh->rollback if $oldAutoCommit;
236 foreach my $pf ( grep { /^phonetypenum(\d+)$/ && $self->get($_) =~ /\S/ }
237 keys %{ $self->hashref } ) {
238 $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
239 my $phonetypenum = $1;
241 my %hash = ( 'contactnum' => $self->contactnum,
242 'phonetypenum' => $phonetypenum,
245 qsearchs('contact_phone', \%hash)
246 || new FS::contact_phone { %hash, _parse_phonestring($self->get($pf)) };
247 my $error = $contact_phone->contactphonenum ? $contact_phone->replace
248 : $contact_phone->insert;
250 $dbh->rollback if $oldAutoCommit;
255 if ( $self->get('emailaddress') =~ /\S/ ) {
257 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
259 'contactnum' => $self->contactnum,
260 'emailaddress' => $email,
262 unless ( qsearchs('contact_email', \%hash) ) {
263 my $contact_email = new FS::contact_email \%hash;
264 my $error = $contact_email->insert;
266 $dbh->rollback if $oldAutoCommit;
274 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
275 #warn " queueing fuzzyfiles update\n"
277 my $error = $self->queue_fuzzyfiles_update;
279 $dbh->rollback if $oldAutoCommit;
280 return "updating fuzzy search cache: $error";
284 if ( $link_hash{'selfservice_access'} eq 'R'
285 or ( $link_hash{'selfservice_access'}
287 && ! length($self->_password)
291 my $error = $self->send_reset_email( queue=>1 );
293 $dbh->rollback if $oldAutoCommit;
298 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
306 Delete this record from the database.
313 local $SIG{HUP} = 'IGNORE';
314 local $SIG{INT} = 'IGNORE';
315 local $SIG{QUIT} = 'IGNORE';
316 local $SIG{TERM} = 'IGNORE';
317 local $SIG{TSTP} = 'IGNORE';
318 local $SIG{PIPE} = 'IGNORE';
320 my $oldAutoCommit = $FS::UID::AutoCommit;
321 local $FS::UID::AutoCommit = 0;
324 #got a prospetnum or custnum? delete the prospect_contact or cust_contact link
326 if ( $self->prospectnum ) {
327 my $prospect_contact = qsearchs('prospect_contact', {
328 'contactnum' => $self->contactnum,
329 'prospectnum' => $self->prospectnum,
331 my $error = $prospect_contact->delete;
333 $dbh->rollback if $oldAutoCommit;
338 if ( $self->custnum ) {
339 my $cust_contact = qsearchs('cust_contact', {
340 'contactnum' => $self->contactnum,
341 'custnum' => $self->custnum,
343 my $error = $cust_contact->delete;
345 $dbh->rollback if $oldAutoCommit;
350 # then, proceed with deletion only if the contact isn't attached to any other
351 # prospects or customers
353 #inefficient, but how many prospects/customers can a single contact be
354 # attached too? (and is removing them from one a common operation?)
355 if ( $self->prospect_contact || $self->cust_contact ) {
356 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
360 #proceed with deletion
362 foreach my $cust_pkg ( $self->cust_pkg ) {
363 $cust_pkg->contactnum('');
364 my $error = $cust_pkg->replace;
366 $dbh->rollback if $oldAutoCommit;
371 foreach my $object ( $self->contact_phone, $self->contact_email ) {
372 my $error = $object->delete;
374 $dbh->rollback if $oldAutoCommit;
379 my $error = $self->SUPER::delete;
381 $dbh->rollback if $oldAutoCommit;
385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
390 =item replace OLD_RECORD
392 Replaces the OLD_RECORD with this one in the database. If there is an error,
393 returns the error, otherwise returns false.
400 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
402 : $self->replace_old;
404 $self->$_( $self->$_ || $old->$_ ) for qw( _password _password_encoding );
406 local $SIG{INT} = 'IGNORE';
407 local $SIG{QUIT} = 'IGNORE';
408 local $SIG{TERM} = 'IGNORE';
409 local $SIG{TSTP} = 'IGNORE';
410 local $SIG{PIPE} = 'IGNORE';
412 my $oldAutoCommit = $FS::UID::AutoCommit;
413 local $FS::UID::AutoCommit = 0;
416 #save off and blank values that move to cust_contact / prospect_contact now
417 my $prospectnum = $self->prospectnum;
418 $self->prospectnum('');
419 my $custnum = $self->custnum;
423 for (qw( classnum comment selfservice_access )) {
424 $link_hash{$_} = $self->get($_);
428 my $error = $self->SUPER::replace($old);
430 $dbh->rollback if $oldAutoCommit;
434 my $cust_contact = '';
436 my %hash = ( 'contactnum' => $self->contactnum,
437 'custnum' => $custnum,
440 if ( $cust_contact = qsearchs('cust_contact', \%hash ) ) {
441 $cust_contact->$_($link_hash{$_}) for keys %link_hash;
442 $error = $cust_contact->replace;
444 $cust_contact = new FS::cust_contact { %hash, %link_hash };
445 $error = $cust_contact->insert;
448 $dbh->rollback if $oldAutoCommit;
453 if ( $prospectnum ) {
454 my %hash = ( 'contactnum' => $self->contactnum,
455 'prospectnum' => $prospectnum,
458 if ( my $prospect_contact = qsearchs('prospect_contact', \%hash ) ) {
459 $prospect_contact->$_($link_hash{$_}) for keys %link_hash;
460 $error = $prospect_contact->replace;
462 my $prospect_contact = new FS::prospect_contact { %hash, %link_hash };
463 $error = $prospect_contact->insert;
466 $dbh->rollback if $oldAutoCommit;
471 foreach my $pf ( grep { /^phonetypenum(\d+)$/ }
472 keys %{ $self->hashref } ) {
473 $pf =~ /^phonetypenum(\d+)$/ or die "wtf (daily, the)";
474 my $phonetypenum = $1;
476 my %cp = ( 'contactnum' => $self->contactnum,
477 'phonetypenum' => $phonetypenum,
479 my $contact_phone = qsearchs('contact_phone', \%cp);
481 my $pv = $self->get($pf);
484 #if new value is empty, delete old entry
486 if ($contact_phone) {
487 $error = $contact_phone->delete;
489 $dbh->rollback if $oldAutoCommit;
496 $contact_phone ||= new FS::contact_phone \%cp;
498 my %cpd = _parse_phonestring( $pv );
499 $contact_phone->set( $_ => $cpd{$_} ) foreach keys %cpd;
501 my $method = $contact_phone->contactphonenum ? 'replace' : 'insert';
503 $error = $contact_phone->$method;
505 $dbh->rollback if $oldAutoCommit;
510 if ( defined($self->hashref->{'emailaddress'}) ) {
512 #ineffecient but whatever, how many email addresses can there be?
514 foreach my $contact_email ( $self->contact_email ) {
515 my $error = $contact_email->delete;
517 $dbh->rollback if $oldAutoCommit;
522 foreach my $email ( split(/\s*,\s*/, $self->get('emailaddress') ) ) {
524 my $contact_email = new FS::contact_email {
525 'contactnum' => $self->contactnum,
526 'emailaddress' => $email,
528 $error = $contact_email->insert;
530 $dbh->rollback if $oldAutoCommit;
538 unless ( $skip_fuzzyfiles ) { #unless ( $import || $skip_fuzzyfiles ) {
539 #warn " queueing fuzzyfiles update\n"
541 $error = $self->queue_fuzzyfiles_update;
543 $dbh->rollback if $oldAutoCommit;
544 return "updating fuzzy search cache: $error";
548 if ( $cust_contact and (
549 ( $cust_contact->selfservice_access eq ''
550 && $link_hash{selfservice_access}
551 && ! length($self->_password)
553 || $cust_contact->_resend()
557 my $error = $self->send_reset_email( queue=>1 );
559 $dbh->rollback if $oldAutoCommit;
564 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
570 =item _parse_phonestring PHONENUMBER_STRING
572 Subroutine, takes a string and returns a list (suitable for assigning to a hash)
573 with keys 'countrycode', 'phonenum' and 'extension'
575 (Should probably be moved to contact_phone.pm, hence the initial underscore.)
579 sub _parse_phonestring {
582 my($countrycode, $extension) = ('1', '');
585 if ( $value =~ s/^\s*\+\s*(\d+)// ) {
591 if ( $value =~ s/\s*(ext|x)\s*(\d+)\s*$//i ) {
595 ( 'countrycode' => $countrycode,
596 'phonenum' => $value,
597 'extension' => $extension,
601 =item queue_fuzzyfiles_update
603 Used by insert & replace to update the fuzzy search cache
607 use FS::cust_main::Search;
608 sub queue_fuzzyfiles_update {
611 local $SIG{HUP} = 'IGNORE';
612 local $SIG{INT} = 'IGNORE';
613 local $SIG{QUIT} = 'IGNORE';
614 local $SIG{TERM} = 'IGNORE';
615 local $SIG{TSTP} = 'IGNORE';
616 local $SIG{PIPE} = 'IGNORE';
618 my $oldAutoCommit = $FS::UID::AutoCommit;
619 local $FS::UID::AutoCommit = 0;
622 foreach my $field ( 'first', 'last' ) {
623 my $queue = new FS::queue {
624 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
626 my @args = "contact.$field", $self->get($field);
627 my $error = $queue->insert( @args );
629 $dbh->rollback if $oldAutoCommit;
630 return "queueing job (transaction rolled back): $error";
634 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
641 Checks all fields to make sure this is a valid contact. If there is
642 an error, returns the error, otherwise returns false. Called by the insert
650 if ( $self->selfservice_access eq 'R' ) {
651 $self->selfservice_access('Y');
656 $self->ut_numbern('contactnum')
657 || $self->ut_foreign_keyn('prospectnum', 'prospect_main', 'prospectnum')
658 || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum')
659 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
660 || $self->ut_foreign_keyn('classnum', 'contact_class', 'classnum')
661 || $self->ut_namen('last')
662 || $self->ut_namen('first')
663 || $self->ut_textn('title')
664 || $self->ut_textn('comment')
665 || $self->ut_enum('selfservice_access', [ '', 'Y' ])
666 || $self->ut_textn('_password')
667 || $self->ut_enum('_password_encoding', [ '', 'bcrypt'])
668 || $self->ut_enum('disabled', [ '', 'Y' ])
669 || $self->ut_flag('invoice_dest')
671 return $error if $error;
673 return "Prospect and customer!" if $self->prospectnum && $self->custnum;
675 return "One of first name, last name, or title must have a value"
676 if ! grep $self->$_(), qw( first last title);
683 Returns a formatted string representing this contact, including name, title and
690 my $data = $self->first. ' '. $self->last;
691 $data .= ', '. $self->title
693 $data .= ' ('. $self->comment. ')'
700 Returns a formatted string representing this contact, with just the name.
706 $self->first . ' ' . $self->last;
709 #=item contact_classname PROSPECT_OBJ | CUST_MAIN_OBJ
711 #Returns the name of this contact's class for the specified prospect or
712 #customer (see L<FS::prospect_contact>, L<FS::cust_contact> and
713 #L<FS::contact_class>).
717 #sub contact_classname {
718 # my( $self, $prospect_or_cust ) = @_;
721 # if ( ref($prospect_or_cust) eq 'FS::prospect_main' ) {
722 # $link = qsearchs('prospect_contact', {
723 # 'contactnum' => $self->contactnum,
724 # 'prospectnum' => $prospect_or_cust->prospectnum,
726 # } elsif ( ref($prospect_or_cust) eq 'FS::cust_main' ) {
727 # $link = qsearchs('cust_contact', {
728 # 'contactnum' => $self->contactnum,
729 # 'custnum' => $prospect_or_cust->custnum,
732 # croak "$prospect_or_cust is not an FS::prospect_main or FS::cust_main object";
735 # my $contact_class = $link->contact_class or return '';
736 # $contact_class->classname;
739 =item by_selfservice_email EMAILADDRESS
741 Alternate search constructor (class method). Given an email address,
742 returns the contact for that address, or the empty string if no contact
743 has that email address.
747 sub by_selfservice_email {
748 my($class, $email) = @_;
750 my $contact_email = qsearchs({
751 'table' => 'contact_email',
752 'addl_from' => ' LEFT JOIN contact USING ( contactnum ) ',
753 'hashref' => { 'emailaddress' => $email, },
754 'extra_sql' => " AND ( disabled IS NULL OR disabled = '' )",
757 $contact_email->contact;
761 #these three functions are very much false laziness w/FS/FS/Auth/internal.pm
762 # and should maybe be libraried in some way for other password needs
764 use Crypt::Eksblowfish::Bcrypt qw( bcrypt_hash en_base64 de_base64);
766 sub authenticate_password {
767 my($self, $check_password) = @_;
769 if ( $self->_password_encoding eq 'bcrypt' ) {
771 my( $cost, $salt, $hash ) = split(',', $self->_password);
773 my $check_hash = en_base64( bcrypt_hash( { key_nul => 1,
775 salt => de_base64($salt),
781 $hash eq $check_hash;
785 return 0 if $self->_password eq '';
787 $self->_password eq $check_password;
793 sub change_password {
794 my($self, $new_password) = @_;
796 $self->change_password_fields( $new_password );
802 sub change_password_fields {
803 my($self, $new_password) = @_;
805 $self->_password_encoding('bcrypt');
809 my $salt = pack( 'C*', map int(rand(256)), 1..16 );
811 my $hash = bcrypt_hash( { key_nul => 1,
819 join(',', $cost, en_base64($salt), en_base64($hash) )
824 # end of false laziness w/FS/FS/Auth/internal.pm
827 #false laziness w/ClientAPI/MyAccount/reset_passwd
828 use Digest::SHA qw(sha512_hex);
830 use FS::ClientAPI_SessionCache;
831 sub send_reset_email {
832 my( $self, %opt ) = @_;
834 my @contact_email = $self->contact_email or return '';
836 my $reset_session = {
837 'contactnum' => $self->contactnum,
838 'svcnum' => $opt{'svcnum'},
841 my $timeout = '24 hours'; #?
843 my $reset_session_id;
845 $reset_session_id = sha512_hex(time(). {}. rand(). $$)
846 } until ( ! defined $self->myaccount_cache->get("reset_passwd_$reset_session_id") );
849 $self->myaccount_cache->set( "reset_passwd_$reset_session_id", $reset_session, $timeout );
853 my $conf = new FS::Conf;
856 my @cust_contact = grep $_->selfservice_access, $self->cust_contact;
857 $cust_main = $cust_contact[0]->cust_main if scalar(@cust_contact) == 1;
859 my $agentnum = $cust_main ? $cust_main->agentnum : '';
860 my $msgnum = $conf->config('selfservice-password_reset_msgnum', $agentnum);
861 #die "selfservice-password_reset_msgnum unset" unless $msgnum;
862 return { 'error' => "selfservice-password_reset_msgnum unset" } unless $msgnum;
863 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum } );
864 return { 'error' => "selfservice-password_reset_msgnum cannot be loaded" } unless $msg_template;
866 'to' => join(',', map $_->emailaddress, @contact_email ),
867 'cust_main' => $cust_main,
869 'substitutions' => { 'session_id' => $reset_session_id }
872 if ( $opt{'queue'} ) { #or should queueing just be the default?
874 my $cust_msg = $msg_template->prepare( %msg_template );
875 my $error = $cust_msg->insert;
876 return { 'error' => $error } if $error;
877 my $queue = new FS::queue {
878 'job' => 'FS::cust_msg::process_send',
879 'custnum' => $cust_main ? $cust_main->custnum : '',
881 $queue->insert( $cust_msg->custmsgnum );
885 $msg_template->send( %msg_template );
891 use vars qw( $myaccount_cache );
892 sub myaccount_cache {
894 $myaccount_cache ||= new FS::ClientAPI_SessionCache( {
895 'namespace' => 'FS::ClientAPI::MyAccount',
899 =item cgi_contact_fields
901 Returns a list reference containing the set of contact fields used in the web
902 interface for one-line editing (i.e. excluding contactnum, prospectnum, custnum
903 and locationnum, as well as password fields, but including fields for
904 contact_email and contact_phone records.)
908 sub cgi_contact_fields {
911 my @contact_fields = qw(
912 classnum first last title comment emailaddress selfservice_access
916 push @contact_fields, 'phonetypenum'. $_->phonetypenum
917 foreach qsearch({table=>'phone_type', order_by=>'weight'});
923 use FS::upgrade_journal;
924 sub _upgrade_data { #class method
925 my ($class, %opts) = @_;
927 # always migrate cust_main_invoice records over
928 local $FS::cust_main::import = 1; # override require_phone and such
929 my $search = FS::Cursor->new('cust_main_invoice', {});
930 while (my $cust_main_invoice = $search->fetch) {
931 my $custnum = $cust_main_invoice->custnum;
932 my $dest = $cust_main_invoice->dest;
933 my $cust_main = $cust_main_invoice->cust_main;
935 if ( $dest =~ /^\d+$/ ) {
936 my $svc_acct = FS::svc_acct->by_key($dest);
937 die "custnum $custnum, invoice destination svcnum $svc_acct does not exist\n"
939 $dest = $svc_acct->email;
942 my $error = $cust_main->replace( [ $dest ] );
945 die "custnum $custnum, invoice destination $dest, creating contact: $error\n";
948 $error = $cust_main_invoice->delete;
949 die "custnum $custnum, cleaning up cust_main_invoice: $error\n" if $error;
951 } # while $search->fetch
953 unless ( FS::upgrade_journal->is_done('contact__DUPEMAIL') ) {
955 foreach my $contact (qsearch('contact', {})) {
956 my $error = $contact->replace;
957 die $error if $error;
960 FS::upgrade_journal->set_done('contact__DUPEMAIL');
971 L<FS::Record>, schema.html from the base documentation.