X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=e107e6c91239165e176949e6c22fe5157b0837d2;hp=ca5a4e83f29ffb976afa5075d7487f816c4e3a3c;hb=1ec723c2b944c08c32362d05cefe8b332c80276d;hpb=5c35f5323f1cdcf7eabe6632d0352ea417d3047e diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index ca5a4e83f..e107e6c91 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,8 +2,13 @@ package FS::cust_main; require 5.006; use strict; -use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card @paytypes); +use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record ); +use vars qw( @EXPORT_OK $DEBUG $me $conf + @encrypted_fields + $import $ignore_expired_card + $skip_fuzzyfiles @fuzzyfields + @paytypes + ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -11,6 +16,8 @@ use Exporter; use Scalar::Util qw( blessed ); use List::Util qw( min ); use Time::Local qw(timelocal); +use Storable qw(thaw); +use MIME::Base64; use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); @@ -21,7 +28,7 @@ use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); -use FS::Record qw( qsearchs qsearch dbdef ); +use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::payby; @@ -41,6 +48,7 @@ use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::cust_location; +use FS::cust_class; use FS::cust_main_exemption; use FS::cust_tax_adjustment; use FS::tax_rate; @@ -49,6 +57,7 @@ use FS::cust_tax_location; use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; +use FS::cust_tag; use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; @@ -56,16 +65,14 @@ use FS::queue; use FS::part_pkg; use FS::part_event; use FS::part_event_condition; +use FS::part_export; #use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; -use FS::payinfo_Mixin; use FS::TicketSystem; -@ISA = qw( FS::payinfo_Mixin FS::Record ); - @EXPORT_OK = qw( smart_search ); $realtime_bop_decline_quiet = 0; @@ -77,11 +84,13 @@ $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; -$skip_fuzzyfiles = 0; $ignore_expired_card = 0; +$skip_fuzzyfiles = 0; +@fuzzyfields = ( 'first', 'last', 'company', 'address1' ); + @encrypted_fields = ('payinfo', 'paycvv'); -sub nohistory_fields { ('paycvv'); } +sub nohistory_fields { ('payinfo', 'paycvv'); } @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); @@ -297,9 +306,9 @@ IP address from which payment information was received Tax exempt, empty or `Y' -=item otaker +=item usernum -Order taker (assigned automatically, see L) +Order taker (see L) =item comments @@ -465,6 +474,30 @@ sub insert { $self->invoicing_list( $invoicing_list ); } + warn " setting customer tags\n" + if $DEBUG > 1; + + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $invoicing_list ) { + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + #return "checking invoicing_list (transaction rolled back): $error"; + return $error; + } + $self->invoicing_list( $invoicing_list ); + } + + warn " setting cust_main_exemption\n" if $DEBUG > 1; @@ -541,6 +574,45 @@ sub insert { } } + # cust_main exports! + warn " exporting\n" if $DEBUG > 1; + + my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_insert($self, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + + #foreach my $depend_jobnum ( @$depend_jobnums ) { + # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n" + # if $DEBUG; + # foreach my $jobnum ( @jobnums ) { + # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); + # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n" + # if $DEBUG; + # my $error = $queue->depend_insert($depend_jobnum); + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return "error queuing job dependancy: $error"; + # } + # } + # } + # + #} + # + #if ( exists $options{'jobnums'} ) { + # push @{ $options{'jobnums'} }, @jobnums; + #} + warn " insert complete; committing transaction\n" if $DEBUG > 1; @@ -1309,23 +1381,13 @@ sub delete { } } - foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_invoice->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - foreach my $cust_main_exemption ( - qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) - ) { - my $error = $cust_main_exemption->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + foreach my $table (qw( cust_main_invoice cust_main_exemption cust_tag )) { + foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) { + my $error = $record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } @@ -1335,6 +1397,23 @@ sub delete { return $error; } + # cust_main exports! + + #my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_delete( $self ); #, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1414,6 +1493,28 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident + + #this could be more efficient than deleting and re-inserting, if it matters + foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) { + my $error = $cust_tag->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + foreach my $tagnum ( @{ $self->tagnum || [] } ) { + my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum, + 'custnum' => $self->custnum }; + my $error = $cust_tag->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + my %options = @param; my $tax_exemption = delete $options{'tax_exemption'}; @@ -1448,8 +1549,15 @@ sub replace { } - if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && - grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ + && ( ( $self->get('payinfo') ne $old->get('payinfo') + && $self->get('payinfo') !~ /^99\d{14}$/ + ) + || grep { $self->get($_) ne $old->get($_) } qw(paydate payname) + ) + ) + { + # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { @@ -1466,6 +1574,23 @@ sub replace { } } + # cust_main exports! + + my $export_args = $options{'export_args'} || []; + + my @part_export = + map qsearch( 'part_export', {exportnum=>$_} ), + $conf->config('cust_main-exports'); #, $agentnum + + foreach my $part_export ( @part_export ) { + my $error = $part_export->export_replace( $self, $old, @$export_args); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1492,9 +1617,7 @@ sub queue_fuzzyfiles_update { my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert( map $self->getfield($_), - qw(first last company) - ); + my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1502,9 +1625,7 @@ sub queue_fuzzyfiles_update { if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert( map $self->getfield("ship_$_"), - qw(first last company) - ); + $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1535,6 +1656,7 @@ sub check { || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') @@ -1706,12 +1828,7 @@ sub check { # If it is encrypted and the private key is not availaible then we can't # check the credit card. - - my $check_payinfo = 1; - - if ($self->is_encrypted($self->payinfo)) { - $check_payinfo = 0; - } + my $check_payinfo = ! $self->is_encrypted($self->payinfo); if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { @@ -1725,7 +1842,8 @@ sub check { or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') - if cardtype($self->payinfo) eq "Unknown"; + if $self->payinfo !~ /^99\d{14}$/ #token + && cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { @@ -1845,6 +1963,8 @@ sub check { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); + } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { + ( $m, $y ) = ( $2, "19$1" ); } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { @@ -1906,6 +2026,25 @@ sub has_ship_address { scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } +=item location_hash + +Returns a list of key/value pairs, with the following keys: address1, adddress2, +city, county, state, zip, country. The shipping address is used if present. + +=cut + +#geocode? dependent on tax-ship_address config, not available in cust_location +#mostly. not yet then. + +sub location_hash { + my $self = shift; + my $prefix = $self->has_ship_address ? 'ship_' : ''; + + map { $_ => $self->get($prefix.$_) } + qw( address1 address2 city county state zip country geocode ); + #fields that cust_location has +} + =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L) for this customer. @@ -1949,6 +2088,61 @@ sub cust_location { qsearch('cust_location', { 'custnum' => $self->custnum } ); } +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the service location (see analog in L) for this customer. + +Options are + +=over 4 + +=item join_string + +used to separate the address elements (defaults to ', ') + +=item escape_function + +a callback used for escaping the text of the address elements + +=back + +=cut + +# false laziness with FS::cust_location::line + +sub location_label { + my $self = shift; + my %opt = @_; + + my $separator = $opt{join_string} || ', '; + my $escape = $opt{escape_function} || sub{ shift }; + my $line = ''; + my $cydefault = FS::conf->new->config('countrydefault') || 'US'; + my $prefix = length($self->ship_last) ? 'ship_' : ''; + + my $notfirst = 0; + foreach (qw ( address1 address2 ) ) { + my $method = "$prefix$_"; + $line .= ($notfirst ? $separator : ''). &$escape($self->$method) + if $self->$method; + $notfirst++; + } + $notfirst = 0; + foreach (qw ( city county state zip ) ) { + my $method = "$prefix$_"; + if ( $self->$method ) { + $line .= ' (' if $method eq 'county'; + $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); + $line .= ' )' if $method eq 'county'; + $notfirst++; + } + } + $line .= $separator. &$escape(code2country($self->country)) + if $self->country ne $cydefault; + + $line; +} + =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. @@ -2010,6 +2204,9 @@ sub _cust_pkg { # This should be generalized to use config options to determine order. sub sort_packages { + my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); + return $locationsort if $locationsort; + if ( $a->get('cancel') xor $b->get('cancel') ) { return -1 if $b->get('cancel'); return 1 if $a->get('cancel'); @@ -2023,6 +2220,9 @@ sub sort_packages { return 1 if !$a_num_cust_svc && $b_num_cust_svc; my @a_cust_svc = $a->cust_svc; my @b_cust_svc = $b->cust_svc; + return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc); + return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc); + return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc); $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } @@ -2301,12 +2501,97 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item agent_name + +Returns the agent name (see L) for this customer. + +=cut + +sub agent_name { + my $self = shift; + $self->agent->agent; +} + +=item cust_tag + +Returns any tags associated with this customer, as FS::cust_tag objects, +or an empty list if there are no tags. + +=cut + +sub cust_tag { + my $self = shift; + qsearch('cust_tag', { 'custnum' => $self->custnum } ); +} + +=item part_tag + +Returns any tags associated with this customer, as FS::part_tag objects, +or an empty list if there are no tags. + +=cut + +sub part_tag { + my $self = shift; + map $_->part_tag, $self->cust_tag; +} + + +=item cust_class + +Returns the customer class, as an FS::cust_class object, or the empty string +if there is no customer class. + +=cut + +sub cust_class { + my $self = shift; + if ( $self->classnum ) { + qsearchs('cust_class', { 'classnum' => $self->classnum } ); + } else { + return ''; + } +} + +=item categoryname + +Returns the customer category name, or the empty string if there is no customer +category. + +=cut + +sub categoryname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->categoryname + : ''; +} + +=item classname + +Returns the customer class name, or the empty string if there is no customer +class. + +=cut + +sub classname { + my $self = shift; + my $cust_class = $self->cust_class; + $cust_class + ? $cust_class->classname + : ''; +} + + =item bill_and_collect Cancels and suspends any packages due, generates bills, applies payments and -cred +credits, and applies collection events to run cards, send bills and notices, +etc. -Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) +By default, warns on errors and continues with the next operation (but see the +"fatal" flag below). Options are passed as name-value pairs. Currently available options are: @@ -2332,10 +2617,20 @@ Used in conjunction with the I