require 5.006;
use strict;
-use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
+ #FS::cust_main:_Marketgear when they're ready to move to 2.1
+use base qw( FS::cust_main::Packages FS::cust_main::Status
+ FS::cust_main::Billing FS::cust_main::Billing_Realtime
+ FS::cust_main::Billing_Discount
FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
+ FS::geocode_Mixin
FS::Record
);
use vars qw( $DEBUG $me $conf
@encrypted_fields
- $import $ignore_expired_card
- $skip_fuzzyfiles @fuzzyfields
+ $import
+ $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
+ $skip_fuzzyfiles
@paytypes
);
-use vars qw( $realtime_bop_decline_quiet ); #ugh
use Carp;
use Scalar::Util qw( blessed );
-use List::Util qw( min );
use Time::Local qw(timelocal);
use Storable qw(thaw);
use MIME::Base64;
use Digest::MD5 qw(md5_base64);
use Date::Format;
#use Date::Manip;
-use File::Temp qw( tempfile );
+use File::Temp; #qw( tempfile );
use Business::CreditCard 0.28;
use Locale::Country;
use FS::UID qw( getotaker dbh driver_name );
use FS::Misc qw( generate_email send_email generate_ps do_print );
use FS::Msgcat qw(gettext);
use FS::CurrentUser;
+use FS::TicketSystem;
use FS::payby;
use FS::cust_pkg;
use FS::cust_svc;
use FS::cust_bill;
+use FS::legacy_cust_bill;
use FS::cust_pay;
use FS::cust_pay_pending;
use FS::cust_pay_void;
use FS::prepay_credit;
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::TicketSystem;
-
-$realtime_bop_decline_quiet = 0; #move to Billing_Realtime
+use FS::cust_main_note;
+use FS::cust_attachment;
+use FS::contact;
+use FS::Locales;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
$import = 0;
$ignore_expired_card = 0;
+$ignore_illegal_zip = 0;
+$ignore_banned_card = 0;
$skip_fuzzyfiles = 0;
-@fuzzyfields = ( 'first', 'last', 'company', 'address1' );
@encrypted_fields = ('payinfo', 'paycvv');
sub nohistory_fields { ('payinfo', 'paycvv'); }
phone (optional)
+=item mobile
+
+phone (optional)
+
=item ship_first
Shipping first name
phone (optional)
+=item ship_mobile
+
+phone (optional)
+
=item payby
Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
Discourage individual CDR printing, empty or `Y'
+=item edit_subject
+
+Allow self-service editing of ticket subjects, empty or 'Y'
+
+=item calling_list_exempt
+
+Do not call, empty or 'Y'
+
=back
=head1 METHODS
$cust_main->insert( {}, [ $email, 'POST' ] );
-Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
+Currently available options are: I<depend_jobnum>, I<noexport>,
+I<tax_exemption> and I<prospectnum>.
If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
on the supplied jobnum (they will not run until the specific job completes).
The I<tax_exemption> option can be set to an arrayref of tax names.
FS::cust_main_exemption records will be created and inserted.
+If I<prospectnum> is set, moves contacts and locations from that prospect.
+
=cut
sub insert {
}
}
- if ( $invoicing_list ) {
- $error = $self->check_invoicing_list( $invoicing_list );
+ my $prospectnum = delete $options{'prospectnum'};
+ if ( $prospectnum ) {
+
+ warn " moving contacts and locations from prospect $prospectnum\n"
+ if $DEBUG > 1;
+
+ my $prospect_main =
+ qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
+ unless ( $prospect_main ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Unknown prospectnum $prospectnum";
+ }
+ $prospect_main->custnum($self->custnum);
+ $prospect_main->disabled('Y');
+ my $error = $prospect_main->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
- #return "checking invoicing_list (transaction rolled back): $error";
return $error;
}
- $self->invoicing_list( $invoicing_list );
- }
+ my @contact = $prospect_main->contact;
+ my @cust_location = $prospect_main->cust_location;
+ my @qual = $prospect_main->qual;
+
+ foreach my $r ( @contact, @cust_location, @qual ) {
+ $r->prospectnum('');
+ $r->custnum($self->custnum);
+ my $error = $r->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
warn " setting cust_main_exemption\n"
if $DEBUG > 1;
}
}
- if ( $conf->config('cust_main-skeleton_tables')
- && $conf->config('cust_main-skeleton_custnum') ) {
-
- warn " inserting skeleton records\n"
- if $DEBUG > 1;
-
+ if ( $self->can('start_copy_skel') ) {
my $error = $self->start_copy_skel;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
-
}
warn " ordering packages\n"
}
-sub start_copy_skel {
- my $self = shift;
-
- #'mg_user_preference' => {},
- #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
- #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
- #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
- #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
- my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
- die $@ if $@;
-
- _copy_skel( 'cust_main', #tablename
- $conf->config('cust_main-skeleton_custnum'), #sourceid
- $self->custnum, #destid
- @tables, #child tables
- );
-}
-
-#recursive subroutine, not a method
-sub _copy_skel {
- my( $table, $sourceid, $destid, %child_tables ) = @_;
-
- my $primary_key;
- if ( $table =~ /^(\w+)\.(\w+)$/ ) {
- ( $table, $primary_key ) = ( $1, $2 );
- } else {
- my $dbdef_table = dbdef->table($table);
- $primary_key = $dbdef_table->primary_key
- or return "$table has no primary key".
- " (or do you need to run dbdef-create?)";
- }
-
- warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
- join (', ', keys %child_tables). "\n"
- if $DEBUG > 2;
-
- foreach my $child_table_def ( keys %child_tables ) {
-
- my $child_table;
- my $child_pkey = '';
- if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
- ( $child_table, $child_pkey ) = ( $1, $2 );
- } else {
- $child_table = $child_table_def;
-
- $child_pkey = dbdef->table($child_table)->primary_key;
- # or return "$table has no primary key".
- # " (or do you need to run dbdef-create?)\n";
- }
-
- my $sequence = '';
- if ( keys %{ $child_tables{$child_table_def} } ) {
-
- return "$child_table has no primary key".
- " (run dbdef-create or try specifying it?)\n"
- unless $child_pkey;
-
- #false laziness w/Record::insert and only works on Pg
- #refactor the proper last-inserted-id stuff out of Record::insert if this
- # ever gets use for anything besides a quick kludge for one customer
- my $default = dbdef->table($child_table)->column($child_pkey)->default;
- $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
- or return "can't parse $child_table.$child_pkey default value ".
- " for sequence name: $default";
- $sequence = $1;
-
- }
-
- my @sel_columns = grep { $_ ne $primary_key }
- dbdef->table($child_table)->columns;
- my $sel_columns = join(', ', @sel_columns );
-
- my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
- my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
- my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
-
- my $sel_st = "SELECT $sel_columns FROM $child_table".
- " WHERE $primary_key = $sourceid";
- warn " $sel_st\n"
- if $DEBUG > 2;
- my $sel_sth = dbh->prepare( $sel_st )
- or return dbh->errstr;
-
- $sel_sth->execute or return $sel_sth->errstr;
-
- while ( my $row = $sel_sth->fetchrow_hashref ) {
-
- warn " selected row: ".
- join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
- if $DEBUG > 2;
-
- my $statement =
- "INSERT INTO $child_table $ins_columns VALUES $placeholders";
- my $ins_sth =dbh->prepare($statement)
- or return dbh->errstr;
- my @param = ( $destid, map $row->{$_}, @ins_columns );
- warn " $statement: [ ". join(', ', @param). " ]\n"
- if $DEBUG > 2;
- $ins_sth->execute( @param )
- or return $ins_sth->errstr;
-
- #next unless keys %{ $child_tables{$child_table} };
- next unless $sequence;
-
- #another section of that laziness
- my $seq_sql = "SELECT currval('$sequence')";
- my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
- $seq_sth->execute or return $seq_sth->errstr;
- my $insertid = $seq_sth->fetchrow_arrayref->[0];
-
- # don't drink soap! recurse! recurse! okay!
- my $error =
- _copy_skel( $child_table_def,
- $row->{$child_pkey}, #sourceid
- $insertid, #destid
- %{ $child_tables{$child_table_def} },
- );
- return $error if $error;
-
- }
-
- }
-
- return '';
-
-}
-
-=item order_pkg HASHREF | OPTION => VALUE ...
-
-Orders a single package.
-
-Options may be passed as a list of key/value pairs or as a hash reference.
-Options are:
-
-=over 4
-
-=item cust_pkg
-
-FS::cust_pkg object
-
-=item cust_location
-
-Optional FS::cust_location object
-
-=item svcs
-
-Optional arryaref of FS::svc_* service objects.
-
-=item depend_jobnum
-
-If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
-jobs will have a dependancy on the supplied job (they will not run until the
-specific job completes). This can be used to defer provisioning until some
-action completes (such as running the customer's credit card successfully).
-
-=item ticket_subject
-
-Optional subject for a ticket created and attached to this customer
-
-=item ticket_subject
-
-Optional queue name for ticket additions
-
-=back
-
-=cut
-
-sub order_pkg {
- my $self = shift;
- my $opt = ref($_[0]) ? shift : { @_ };
-
- warn "$me order_pkg called with options ".
- join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
- if $DEBUG;
-
- my $cust_pkg = $opt->{'cust_pkg'};
- my $svcs = $opt->{'svcs'} || [];
-
- my %svc_options = ();
- $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
- if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
-
- my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
- qw( ticket_subject ticket_queue );
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- if ( $opt->{'cust_location'} &&
- ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
- my $error = $opt->{'cust_location'}->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_location (transaction rolled back): $error";
- }
- $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
- }
-
- $cust_pkg->custnum( $self->custnum );
-
- my $error = $cust_pkg->insert( %insert_params );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting cust_pkg (transaction rolled back): $error";
- }
-
- foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
- if ( $svc_something->svcnum ) {
- my $old_cust_svc = $svc_something->cust_svc;
- my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
- $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
- $error = $new_cust_svc->replace($old_cust_svc);
- } else {
- $svc_something->pkgnum( $cust_pkg->pkgnum );
- if ( $svc_something->isa('FS::svc_acct') ) {
- foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
- qw( seconds upbytes downbytes totalbytes ) ) {
- $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
- ${ $opt->{$_.'_ref'} } = 0;
- }
- }
- $error = $svc_something->insert(%svc_options);
- }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "inserting svc_ (transaction rolled back): $error";
- }
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-
-}
-
-#deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
-=item order_pkgs HASHREF [ , OPTION => VALUE ... ]
-
-Like the insert method on an existing record, this method orders multiple
-packages and included services atomicaly. Pass a Tie::RefHash data structure
-to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
-There should be a better explanation of this, but until then, here's an
-example:
-
- use Tie::RefHash;
- tie %hash, 'Tie::RefHash'; #this part is important
- %hash = (
- $cust_pkg => [ $svc_acct ],
- ...
- );
- $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
-
-Services can be new, in which case they are inserted, or existing unaudited
-services, in which case they are linked to the newly-created package.
-
-Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
-I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
-
-If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
-on the supplied jobnum (they will not run until the specific job completes).
-This can be used to defer provisioning until some action completes (such
-as running the customer's credit card successfully).
-
-The I<noexport> option is deprecated. If I<noexport> is set true, no
-provisioning jobs (exports) are scheduled. (You can schedule them later with
-the B<reexport> method for each cust_pkg object. Using the B<reexport> method
-on the cust_main object is not recommended, as existing services will also be
-reexported.)
-
-If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
-provided, the scalars (provided by references) will be incremented by the
-values of the prepaid card.`
-
-=cut
-
-sub order_pkgs {
- my $self = shift;
- my $cust_pkgs = shift;
- my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
- my %options = @_;
- $seconds_ref ||= $options{'seconds_ref'};
-
- warn "$me order_pkgs called with options ".
- join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
- if $DEBUG;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
-
- foreach my $cust_pkg ( keys %$cust_pkgs ) {
+=item PACKAGE METHODS
- my $error = $self->order_pkg(
- 'cust_pkg' => $cust_pkg,
- 'svcs' => $cust_pkgs->{$cust_pkg},
- 'seconds_ref' => $seconds_ref,
- map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
- depend_jobnum
- )
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- ''; #no error
-}
+Documentation on customer package methods has been moved to
+L<FS::cust_main::Packages>.
=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
$prepay_credit = qsearchs(
'prepay_credit',
- { 'identifier' => $prepay_credit },
+ { 'identifier' => $identifier },
'',
'FOR UPDATE'
);
}
-=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
+=item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
+This merges this customer into the provided new custnum, and then deletes the
+customer. If there is an error, returns the error, otherwise returns false.
-Replaces the OLD_RECORD with this one in the database. If there is an error,
-returns the error, otherwise returns false.
+The source customer's name, company name, phone numbers, agent,
+referring customer, customer class, advertising source, order taker, and
+billing information (except balance) are discarded.
-INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
-be set as the invoicing list (see L<"invoicing_list">). Errors return as
-expected and rollback the entire transaction; it is not necessary to call
-check_invoicing_list first. Here's an example:
+All packages are moved to the target customer. Packages with package locations
+are preserved. Packages without package locations are moved to a new package
+location with the source customer's service/shipping address.
- $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+All invoices, statements, payments, credits and refunds are moved to the target
+customer. The source customer's balance is added to the target customer.
-Currently available options are: I<tax_exemption>.
+All notes, attachments, tickets and customer tags are moved to the target
+customer.
-The I<tax_exemption> option can be set to an arrayref of tax names.
-FS::cust_main_exemption records will be deleted and inserted as appropriate.
+Change history is not currently moved.
=cut
-sub replace {
- my $self = shift;
-
- my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
- ? shift
- : $self->replace_old;
-
- my @param = @_;
+sub merge {
+ my( $self, $new_custnum, %opt ) = @_;
- warn "$me replace called\n"
- if $DEBUG;
+ return "Can't merge a customer into self" if $self->custnum == $new_custnum;
- my $curuser = $FS::CurrentUser::CurrentUser;
- if ( $self->payby eq 'COMP'
- && $self->payby ne $old->payby
- && ! $curuser->access_right('Complimentary customer')
- )
- {
- return "You are not permitted to create complimentary accounts.";
+ unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
+ return "Invalid new customer number: $new_custnum";
}
- local($ignore_expired_card) = 1
- if $old->payby =~ /^(CARD|DCRD)$/
- && $self->payby =~ /^(CARD|DCRD)$/
- && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
-
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::replace($old);
+ if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't merge a master agent customer";
+ }
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ #use FS::access_user
+ if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't merge a master employee customer";
}
- if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
- my $invoicing_list = shift @param;
- $error = $self->check_invoicing_list( $invoicing_list );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- $self->invoicing_list( $invoicing_list );
+ if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
+ 'status' => { op=>'!=', value=>'done' },
+ }
+ )
+ ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't merge a customer with pending payments";
}
- if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
+ tie my %financial_tables, 'Tie::IxHash',
+ 'cust_bill' => 'invoices',
+ 'cust_statement' => 'statements',
+ 'cust_credit' => 'credits',
+ 'cust_pay' => 'payments',
+ 'cust_pay_void' => 'voided payments',
+ 'cust_refund' => 'refunds',
+ ;
+
+ foreach my $table ( keys %financial_tables ) {
- #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;
+ my @records = $self->$table();
+
+ foreach my $record ( @records ) {
+ $record->custnum($new_custnum);
+ my $error = $record->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error merging ". $financial_tables{$table}. ": $error\n";
+ }
+ }
+
+ }
+
+ my $name = $self->ship_name;
+
+ my $locationnum = '';
+ foreach my $cust_pkg ( $self->all_pkgs ) {
+ $cust_pkg->custnum($new_custnum);
+
+ unless ( $cust_pkg->locationnum ) {
+ unless ( $locationnum ) {
+ my $cust_location = new FS::cust_location {
+ $self->location_hash,
+ 'custnum' => $new_custnum,
+ };
+ my $error = $cust_location->insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $locationnum = $cust_location->locationnum;
+ }
+ $cust_pkg->locationnum($locationnum);
+ }
+
+ my $error = $cust_pkg->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ # add customer (ship) name to svc_phone.phone_name if blank
+ my @cust_svc = $cust_pkg->cust_svc;
+ foreach my $cust_svc (@cust_svc) {
+ my($label, $value, $svcdb) = $cust_svc->label;
+ next unless $svcdb eq 'svc_phone';
+ my $svc_phone = $cust_svc->svc_x;
+ next if $svc_phone->phone_name;
+ $svc_phone->phone_name($name);
+ my $error = $svc_phone->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
+ }
+
+ #not considered:
+ # cust_tax_exempt (texas tax exemptions)
+ # cust_recon (some sort of not-well understood thing for OnPac)
+
+ #these are moved over
+ foreach my $table (qw(
+ cust_tag cust_location contact cust_attachment cust_main_note
+ cust_tax_adjustment cust_pay_batch queue
+ )) {
+ foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
+ $record->custnum($new_custnum);
+ my $error = $record->replace;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+ #these aren't preserved
+ foreach my $table (qw(
+ cust_main_exemption cust_main_invoice
+ )) {
+ foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
+ my $error = $record->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+ }
+
+
+ my $sth = $dbh->prepare(
+ 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
+ ) or do {
+ my $errstr = $dbh->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+ $sth->execute($new_custnum, $self->custnum) or do {
+ my $errstr = $sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ #tickets
+
+ my $ticket_dbh = '';
+ if ($conf->config('ticket_system') eq 'RT_Internal') {
+ $ticket_dbh = $dbh;
+ } elsif ($conf->config('ticket_system') eq 'RT_External') {
+ my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
+ $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
+ #or die "RT_External DBI->connect error: $DBI::errstr\n";
+ }
+
+ if ( $ticket_dbh ) {
+
+ my $ticket_sth = $ticket_dbh->prepare(
+ 'UPDATE Links SET Target = ? WHERE Target = ?'
+ ) or do {
+ my $errstr = $ticket_dbh->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+ $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
+ 'freeside://freeside/cust_main/'.$self->custnum)
+ or do {
+ my $errstr = $ticket_sth->errstr;
+ $dbh->rollback if $oldAutoCommit;
+ return $errstr;
+ };
+
+ }
+
+ #delete the customer record
+
+ my $error = $self->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
+
+
+Replaces the OLD_RECORD with this one in the database. If there is an error,
+returns the error, otherwise returns false.
+
+INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
+be set as the invoicing list (see L<"invoicing_list">). Errors return as
+expected and rollback the entire transaction; it is not necessary to call
+check_invoicing_list first. Here's an example:
+
+ $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
+
+Currently available options are: I<tax_exemption>.
+
+The I<tax_exemption> option can be set to an arrayref of tax names.
+FS::cust_main_exemption records will be deleted and inserted as appropriate.
+
+=cut
+
+sub replace {
+ my $self = shift;
+
+ my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+ ? shift
+ : $self->replace_old;
+
+ my @param = @_;
+
+ warn "$me replace called\n"
+ if $DEBUG;
+
+ my $curuser = $FS::CurrentUser::CurrentUser;
+ if ( $self->payby eq 'COMP'
+ && $self->payby ne $old->payby
+ && ! $curuser->access_right('Complimentary customer')
+ )
+ {
+ return "You are not permitted to create complimentary accounts.";
+ }
+
+ if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
+ && $conf->exists('enable_taxproducts')
+ )
+ {
+ my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
+ ? 'ship_' : '';
+ $self->set('geocode', '')
+ if $old->get($pre.'zip') ne $self->get($pre.'zip')
+ && length($self->get($pre.'zip')) >= 10;
+ }
+
+ for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) {
+
+ $self->set($pre.'coord_auto', '') && next
+ if $self->get($pre.'latitude') && $self->get($pre.'longitude')
+ && ( $self->get($pre.'latitude') != $old->get($pre.'latitude')
+ || $self->get($pre.'longitude') != $old->get($pre.'longitude')
+ );
+
+ $self->set_coord($pre)
+ if $old->get($pre.'address1') ne $self->get($pre.'address1')
+ || $old->get($pre.'city') ne $self->get($pre.'city')
+ || $old->get($pre.'state') ne $self->get($pre.'state')
+ || $old->get($pre.'country') ne $self->get($pre.'country');
+
+ }
+
+ $self->set_coord
+ if ! $self->coord_auto && ! $self->latitude && ! $self->longitude;
+
+ $self->set_coord('ship_')
+ if $self->has_ship_address && ! $self->ship_coord_auto
+ && ! $self->ship_latitude && ! $self->ship_longitude;
+
+ local($ignore_expired_card) = 1
+ if $old->payby =~ /^(CARD|DCRD)$/
+ && $self->payby =~ /^(CARD|DCRD)$/
+ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
+
+ local($ignore_banned_card) = 1
+ if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
+ || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
+ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error = $self->SUPER::replace($old);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
+ my $invoicing_list = shift @param;
+ $error = $self->check_invoicing_list( $invoicing_list );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ $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;
}
}
=cut
+use FS::cust_main::Search;
sub queue_fuzzyfiles_update {
my $self = shift;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
+ my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' };
+ my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::fuzzyfields );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "queueing job (transaction rolled back): $error";
}
if ( $self->ship_last ) {
- $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
- $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
+ $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' };
+ $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::fuzzyfields );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "queueing job (transaction rolled back): $error";
|| $self->ut_textn('county')
|| $self->ut_textn('state')
|| $self->ut_country('country')
+ || $self->ut_coordn('latitude')
+ || $self->ut_coordn('longitude')
+ || $self->ut_enum('coord_auto', [ '', 'Y' ])
|| $self->ut_anything('comments')
|| $self->ut_numbern('referral_custnum')
|| $self->ut_textn('stateid')
|| $self->ut_textn('invoice_terms')
|| $self->ut_alphan('geocode')
|| $self->ut_floatn('cdr_termination_percentage')
+ || $self->ut_floatn('credit_limit')
+ || $self->ut_numbern('billday')
+ || $self->ut_enum('edit_subject', [ '', 'Y' ] )
+ || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] )
+ || $self->ut_enum('locale', [ '', FS::Locales->locales ])
;
+ $self->set_coord
+ unless $import || ($self->latitude && $self->longitude);
+
#barf. need message catalogs. i18n. etc.
$error .= "Please select an advertising source."
if $error =~ /^Illegal or empty \(numeric\) refnum: /;
}
$error =
- $self->ut_phonen('daytime', $self->country)
- || $self->ut_phonen('night', $self->country)
- || $self->ut_phonen('fax', $self->country)
- || $self->ut_zip('zip', $self->country)
+ $self->ut_phonen('daytime', $self->country)
+ || $self->ut_phonen('night', $self->country)
+ || $self->ut_phonen('fax', $self->country)
+ || $self->ut_phonen('mobile', $self->country)
;
return $error if $error;
+ unless ( $ignore_illegal_zip ) {
+ $error = $self->ut_zip('zip', $self->country);
+ return $error if $error;
+ }
+
if ( $conf->exists('cust_main-require_phone')
- && ! length($self->daytime) && ! length($self->night)
+ && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
) {
my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
? 'Night Phone'
: FS::Msgcat::_gettext('night');
-
- return "$daytime_label or $night_label is required"
+
+ my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
+ ? 'Mobile Phone'
+ : FS::Msgcat::_gettext('mobile');
+
+ return "$daytime_label, $night_label or $mobile_label is required"
}
|| $self->ut_textn('ship_county')
|| $self->ut_textn('ship_state')
|| $self->ut_country('ship_country')
+ || $self->ut_coordn('ship_latitude')
+ || $self->ut_coordn('ship_longitude')
+ || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] )
;
return $error if $error;
+ $self->set_coord('ship_')
+ unless $import || ($self->ship_latitude && $self->ship_longitude);
+
#false laziness with above
unless ( qsearchs('cust_main_county', {
'country' => $self->ship_country,
#eofalse
$error =
- $self->ut_phonen('ship_daytime', $self->ship_country)
- || $self->ut_phonen('ship_night', $self->ship_country)
- || $self->ut_phonen('ship_fax', $self->ship_country)
- || $self->ut_zip('ship_zip', $self->ship_country)
+ $self->ut_phonen('ship_daytime', $self->ship_country)
+ || $self->ut_phonen('ship_night', $self->ship_country)
+ || $self->ut_phonen('ship_fax', $self->ship_country)
+ || $self->ut_phonen('ship_mobile', $self->ship_country)
;
return $error if $error;
+ unless ( $ignore_illegal_zip ) {
+ $error = $self->ut_zip('ship_zip', $self->ship_country);
+ return $error if $error;
+ }
return "Unit # is required."
if $self->ship_address2 =~ /^\s*$/
&& $conf->exists('cust_main-require_address2');
my $payinfo = $self->payinfo;
$payinfo =~ s/\D//g;
- $payinfo =~ /^(\d{13,16})$/
+ $payinfo =~ /^(\d{13,16}|\d{8,9})$/
or return gettext('invalid_card'); # . ": ". $self->payinfo;
$payinfo = $1;
$self->payinfo($payinfo);
if $self->payinfo !~ /^99\d{14}$/ #token
&& cardtype($self->payinfo) eq "Unknown";
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned credit card: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
+ unless ( $ignore_banned_card ) {
+ my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
+ if ( $ban ) {
+ if ( $ban->bantype eq 'warn' ) {
+ #or others depending on value of $ban->reason ?
+ return '_duplicate_card'.
+ ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
+ ' until '. time2str('%a %h %o at %r', $ban->_end_date).
+ ' (ban# '. $ban->bannum. ')'
+ unless $self->override_ban_warn;
+ } else {
+ return 'Banned credit card: banned on '.
+ time2str('%a %h %o at %r', $ban->_date).
+ ' by '. $ban->otaker.
+ ' (ban# '. $ban->bannum. ')';
+ }
+ }
}
if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
} elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
my $payinfo = $self->payinfo;
- $payinfo =~ s/[^\d\@]//g;
- if ( $conf->exists('echeck-nonus') ) {
+ $payinfo =~ s/[^\d\@\.]//g;
+ if ( $conf->exists('cust_main-require-bank-branch') ) {
+ $payinfo =~ /^(\d+)\@(\d+)\.(\d+)$/ or return 'invalid echeck account@branch.bank';
+ $payinfo = "$1\@$2.$3";
+ } elsif ( $conf->exists('echeck-nonus') ) {
$payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
$payinfo = "$1\@$2";
} else {
$self->payinfo($payinfo);
$self->paycvv('');
- my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
- if ( $ban ) {
- return 'Banned ACH account: banned on '.
- time2str('%a %h %o at %r', $ban->_date).
- ' by '. $ban->otaker.
- ' (ban# '. $ban->bannum. ')';
+ unless ( $ignore_banned_card ) {
+ my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
+ if ( $ban ) {
+ if ( $ban->bantype eq 'warn' ) {
+ #or others depending on value of $ban->reason ?
+ return '_duplicate_ach' unless $self->override_ban_warn;
+ } else {
+ return 'Banned ACH account: banned on '.
+ time2str('%a %h %o at %r', $ban->_date).
+ ' by '. $ban->otaker.
+ ' (ban# '. $ban->bannum. ')';
+ }
+ }
}
} elsif ( $self->payby eq 'LECB' ) {
} else {
return "Illegal expiration date: ". $self->paydate;
}
+ $m = sprintf('%02d',$m);
$self->paydate("$y-$m-01");
my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
return gettext('expired_card')
sub addr_fields {
qw( last first company
address1 address2 city county state zip country
- daytime night fax
+ latitude longitude
+ daytime night fax mobile
);
}
=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.
+city, county, state, zip, country, and geocode. The shipping address is used if present.
=cut
-#geocode? dependent on tax-ship_address config, not available in cust_location
-#mostly. not yet then.
+=item cust_location
+
+Returns all locations (see L<FS::cust_location>) for this customer.
-sub location_hash {
- my $self = shift;
- my $prefix = $self->has_ship_address ? 'ship_' : '';
+=cut
- map { $_ => $self->get($prefix.$_) }
- qw( address1 address2 city county state zip country geocode );
- #fields that cust_location has
+sub cust_location {
+ my $self = shift;
+ qsearch('cust_location', { 'custnum' => $self->custnum } );
}
-=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
+=item cust_contact
-Returns all packages (see L<FS::cust_pkg>) for this customer.
+Returns all contacts (see L<FS::contact>) for this customer.
=cut
-sub all_pkgs {
+#already used :/ sub contact {
+sub cust_contact {
my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : {};
-
- return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
-
- my @cust_pkg = ();
- if ( $self->{'_pkgnum'} ) {
- @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
- } else {
- @cust_pkg = $self->_cust_pkg($extra_qsearch);
- }
-
- sort sort_packages @cust_pkg;
+ qsearch('contact', { 'custnum' => $self->custnum } );
}
-=item cust_pkg
+=item unsuspend
-Synonym for B<all_pkgs>.
+Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
+and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
+on success or a list of errors.
=cut
-sub cust_pkg {
- shift->all_pkgs(@_);
+sub unsuspend {
+ my $self = shift;
+ grep { $_->unsuspend } $self->suspended_pkgs;
}
-=item cust_location
+=item suspend
-Returns all locations (see L<FS::cust_location>) for this customer.
+Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
+
+Returns a list: an empty list on success or a list of errors.
=cut
-sub cust_location {
+sub suspend {
my $self = shift;
- qsearch('cust_location', { 'custnum' => $self->custnum } );
+ grep { $_->suspend(@_) } $self->unsuspended_pkgs;
}
-=item location_label [ OPTION => VALUE ... ]
-
-Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
+=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
-Options are
+Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
+PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
+of a list of pkgparts; the hashref has the following keys:
=over 4
-=item join_string
+=item pkgparts - listref of pkgparts
-used to separate the address elements (defaults to ', ')
+=item (other options are passed to the suspend method)
-=item escape_function
+=back
-a callback used for escaping the text of the address elements
-=back
+Returns a list: an empty list on success or a list of errors.
=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<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub ncancelled_pkgs {
- my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : {};
-
- return $self->num_ncancelled_pkgs unless wantarray;
-
- my @cust_pkg = ();
- if ( $self->{'_pkgnum'} ) {
-
- warn "$me ncancelled_pkgs: returning cached objects"
- if $DEBUG > 1;
-
- @cust_pkg = grep { ! $_->getfield('cancel') }
- values %{ $self->{'_pkgnum'}->cache };
-
- } else {
-
- warn "$me ncancelled_pkgs: searching for packages with custnum ".
- $self->custnum. "\n"
- if $DEBUG > 1;
-
- $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
-
- @cust_pkg = $self->_cust_pkg($extra_qsearch);
-
- }
-
- sort sort_packages @cust_pkg;
-
-}
-
-sub _cust_pkg {
- my $self = shift;
- my $extra_qsearch = ref($_[0]) ? shift : {};
-
- $extra_qsearch->{'select'} ||= '*';
- $extra_qsearch->{'select'} .=
- ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
- AS _num_cust_svc';
-
- map {
- $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
- $_;
- }
- qsearch({
- %$extra_qsearch,
- 'table' => 'cust_pkg',
- 'hashref' => { 'custnum' => $self->custnum },
- });
-
-}
-
-# 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');
- #shouldn't get here...
- return 0;
- } else {
- my $a_num_cust_svc = $a->num_cust_svc;
- my $b_num_cust_svc = $b->num_cust_svc;
- return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
- return -1 if $a_num_cust_svc && !$b_num_cust_svc;
- 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;
- }
-
-}
-
-=item suspended_pkgs
-
-Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
-
-=cut
-
-sub suspended_pkgs {
- my $self = shift;
- grep { $_->susp } $self->ncancelled_pkgs;
-}
-
-=item unflagged_suspended_pkgs
-
-Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
-customer (thouse packages without the `manual_flag' set).
-
-=cut
-
-sub unflagged_suspended_pkgs {
- my $self = shift;
- return $self->suspended_pkgs
- unless dbdef->table('cust_pkg')->column('manual_flag');
- grep { ! $_->manual_flag } $self->suspended_pkgs;
-}
-
-=item unsuspended_pkgs
-
-Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
-this customer.
-
-=cut
-
-sub unsuspended_pkgs {
- my $self = shift;
- grep { ! $_->susp } $self->ncancelled_pkgs;
-}
-
-=item next_bill_date
-
-Returns the next date this customer will be billed, as a UNIX timestamp, or
-undef if no active package has a next bill date.
-
-=cut
-
-sub next_bill_date {
- my $self = shift;
- min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
-}
-
-=item num_cancelled_pkgs
-
-Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
-customer.
-
-=cut
-
-sub num_cancelled_pkgs {
- shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
-}
-
-sub num_ncancelled_pkgs {
- shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
-}
-
-sub num_pkgs {
- my( $self ) = shift;
- my $sql = scalar(@_) ? shift : '';
- $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
- my $sth = dbh->prepare(
- "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
- ) or die dbh->errstr;
- $sth->execute($self->custnum) or die $sth->errstr;
- $sth->fetchrow_arrayref->[0];
-}
-
-=item unsuspend
-
-Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
-and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
-on success or a list of errors.
-
-=cut
-
-sub unsuspend {
- my $self = shift;
- grep { $_->unsuspend } $self->suspended_pkgs;
-}
-
-=item suspend
-
-Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub suspend {
- my $self = shift;
- grep { $_->suspend(@_) } $self->unsuspended_pkgs;
-}
-
-=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
-
-Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
-PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
-of a list of pkgparts; the hashref has the following keys:
-
-=over 4
-
-=item pkgparts - listref of pkgparts
-
-=item (other options are passed to the suspend method)
-
-=back
-
-
-Returns a list: an empty list on success or a list of errors.
-
-=cut
-
-sub suspend_if_pkgpart {
+sub suspend_if_pkgpart {
my $self = shift;
my (@pkgparts, %opt);
if (ref($_[0]) eq 'HASH'){
=over 4
-=item quiet - can be set true to supress email cancellation notices.
-
-=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
-
-=item ban - can be set true to ban this customer's credit card or ACH information, if present.
-
-=item nobill - can be set true to skip billing if it might otherwise be done.
-
-=back
-
-Always returns a list: an empty list on success or a list of errors.
-
-=cut
-
-# nb that dates are not specified as valid options to this method
-
-sub cancel {
- my( $self, %opt ) = @_;
-
- warn "$me cancel called on customer ". $self->custnum. " with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
- if $DEBUG;
-
- return ( 'access denied' )
- unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
-
- if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
-
- #should try decryption (we might have the private key)
- # and if not maybe queue a job for the server that does?
- return ( "Can't (yet) ban encrypted credit cards" )
- if $self->is_encrypted($self->payinfo);
-
- my $ban = new FS::banned_pay $self->_banned_pay_hashref;
- my $error = $ban->insert;
- return ( $error ) if $error;
-
- }
-
- my @pkgs = $self->ncancelled_pkgs;
-
- if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
- $opt{nobill} = 1;
- my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
- warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
- if $error;
- }
-
- warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
- scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
- if $DEBUG;
-
- grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
-}
-
-sub _banned_pay_hashref {
- my $self = shift;
-
- my %payby2ban = (
- 'CARD' => 'CARD',
- 'DCRD' => 'CARD',
- 'CHEK' => 'CHEK',
- 'DCHK' => 'CHEK'
- );
-
- {
- 'payby' => $payby2ban{$self->payby},
- 'payinfo' => md5_base64($self->payinfo),
- #don't ever *search* on reason! #'reason' =>
- };
-}
-
-=item notes
-
-Returns all notes (see L<FS::cust_main_note>) for this customer.
-
-=cut
-
-sub notes {
- my $self = shift;
- #order by?
- qsearch( 'cust_main_note',
- { 'custnum' => $self->custnum },
- '',
- 'ORDER BY _DATE DESC'
- );
-}
-
-=item agent
-
-Returns the agent (see L<FS::agent>) for this customer.
-
-=cut
-
-sub agent {
- my $self = shift;
- qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
-}
-
-=item agent_name
-
-Returns the agent name (see L<FS::agent>) 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 BILLING METHODS
-
-Documentation on billing methods has been moved to
-L<FS::cust_main::Billing>.
-
-=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Runs billing events; see L<FS::part_event> and the billing events web
-interface.
-
-If there is an error, returns the error, otherwise returns false.
-
-Options are passed as name-value pairs.
-
-Currently available options are:
-
-=over 4
-
-=item time
-
-Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
-
-=item check_freq
-
-"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item quiet
-
-set true to surpress email card/ACH decline notices.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=cut
-
-# =item payby
-#
-# allows for one time override of normal customer billing method
-
-# =item retry
-#
-# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
-
-sub do_cust_event {
- my( $self, %options ) = @_;
- my $time = $options{'time'} || time;
-
- #put below somehow?
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
-
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
-
- $self->select_for_update; #mutex
-
- if ( $DEBUG ) {
- my $balance = $self->balance;
- warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
- }
-
-# if ( exists($options{'retry_card'}) ) {
-# carp 'retry_card option passed to collect is deprecated; use retry';
-# $options{'retry'} ||= $options{'retry_card'};
-# }
-# if ( exists($options{'retry'}) && $options{'retry'} ) {
-# my $error = $self->retry_realtime;
-# if ( $error ) {
-# $dbh->rollback if $oldAutoCommit;
-# return $error;
-# }
-# }
-
- # false laziness w/pay_batch::import_results
-
- my $due_cust_event = $self->due_cust_event(
- 'debug' => ( $options{'debug'} || 0 ),
- 'time' => $time,
- 'check_freq' => $options{'check_freq'},
- 'stage' => ( $options{'stage'} || 'collect' ),
- );
- unless( ref($due_cust_event) ) {
- $dbh->rollback if $oldAutoCommit;
- return $due_cust_event;
- }
-
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- #never want to roll back an event just because it or a different one
- # returned an error
- local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
-
- foreach my $cust_event ( @$due_cust_event ) {
-
- #XXX lock event
-
- #re-eval event conditions (a previous event could have changed things)
- unless ( $cust_event->test_conditions( 'time' => $time ) ) {
- #don't leave stray "new/locked" records around
- my $error = $cust_event->delete;
- return $error if $error;
- next;
- }
-
- {
- local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
- warn " running cust_event ". $cust_event->eventnum. "\n"
- if $DEBUG > 1;
-
- #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
- if ( my $error = $cust_event->do_event() ) {
- #XXX wtf is this? figure out a proper dealio with return value
- #from do_event
- return $error;
- }
- }
-
- }
-
- '';
-
-}
-
-=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
-
-Inserts database records for and returns an ordered listref of new events due
-for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
-events are due, an empty listref is returned. If there is an error, returns a
-scalar error message.
-
-To actually run the events, call each event's test_condition method, and if
-still true, call the event's do_event method.
-
-Options are passed as a hashref or as a list of name-value pairs. Available
-options are:
-
-=over 4
-
-=item check_freq
-
-Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
-
-=item stage
-
-"collect" (the default) or "pre-bill"
-
-=item time
-
-"Current time" for the events.
-
-=item debug
-
-Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
-
-=item eventtable
-
-Only return events for the specified eventtable (by default, events of all eventtables are returned)
-
-=item objects
-
-Explicitly pass the objects to be tested (typically used with eventtable).
-
-=item testonly
-
-Set to true to return the objects, but not actually insert them into the
-database.
-
-=back
-
-=cut
-
-sub due_cust_event {
- my $self = shift;
- my %opt = ref($_[0]) ? %{ $_[0] } : @_;
-
- #???
- #my $DEBUG = $opt{'debug'}
- local($DEBUG) = $opt{'debug'}
- if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
-
- warn "$me due_cust_event called with options ".
- join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
- if $DEBUG;
-
- $opt{'time'} ||= time;
-
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
+=item quiet - can be set true to supress email cancellation notices.
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
+=item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
- $self->select_for_update #mutex
- unless $opt{testonly};
+=item ban - can be set true to ban this customer's credit card or ACH information, if present.
- ###
- # find possible events (initial search)
- ###
-
- my @cust_event = ();
+=item nobill - can be set true to skip billing if it might otherwise be done.
- my @eventtable = $opt{'eventtable'}
- ? ( $opt{'eventtable'} )
- : FS::part_event->eventtables_runorder;
+=back
- foreach my $eventtable ( @eventtable ) {
+Always returns a list: an empty list on success or a list of errors.
- my @objects;
- if ( $opt{'objects'} ) {
+=cut
- @objects = @{ $opt{'objects'} };
+# nb that dates are not specified as valid options to this method
- } else {
+sub cancel {
+ my( $self, %opt ) = @_;
- #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
- @objects = ( $eventtable eq 'cust_main' )
- ? ( $self )
- : ( $self->$eventtable() );
+ warn "$me cancel called on customer ". $self->custnum. " with options ".
+ join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
+ if $DEBUG;
- }
+ return ( 'access denied' )
+ unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
- my @e_cust_event = ();
+ if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
- my $cross = "CROSS JOIN $eventtable";
- $cross .= ' LEFT JOIN cust_main USING ( custnum )'
- unless $eventtable eq 'cust_main';
+ #should try decryption (we might have the private key)
+ # and if not maybe queue a job for the server that does?
+ return ( "Can't (yet) ban encrypted credit cards" )
+ if $self->is_encrypted($self->payinfo);
- foreach my $object ( @objects ) {
+ my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
+ my $error = $ban->insert;
+ return ( $error ) if $error;
- #this first search uses the condition_sql magic for optimization.
- #the more possible events we can eliminate in this step the better
+ }
- my $cross_where = '';
- my $pkey = $object->primary_key;
- $cross_where = "$eventtable.$pkey = ". $object->$pkey();
+ my @pkgs = $self->ncancelled_pkgs;
- my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
- my $extra_sql =
- FS::part_event_condition->where_conditions_sql( $eventtable,
- 'time'=>$opt{'time'}
- );
- my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
+ if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
+ $opt{nobill} = 1;
+ my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
+ warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
+ if $error;
+ }
- $extra_sql = "AND $extra_sql" if $extra_sql;
+ warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
+ scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
+ if $DEBUG;
- #here is the agent virtualization
- $extra_sql .= " AND ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
+ grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
+}
- $extra_sql .= " $order";
+sub _banned_pay_hashref {
+ my $self = shift;
- warn "searching for events for $eventtable ". $object->$pkey. "\n"
- if $opt{'debug'} > 2;
- my @part_event = qsearch( {
- 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
- 'select' => 'part_event.*',
- 'table' => 'part_event',
- 'addl_from' => "$cross $join",
- 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
- 'eventtable' => $eventtable,
- 'disabled' => '',
- },
- 'extra_sql' => "AND $cross_where $extra_sql",
- } );
+ my %payby2ban = (
+ 'CARD' => 'CARD',
+ 'DCRD' => 'CARD',
+ 'CHEK' => 'CHEK',
+ 'DCHK' => 'CHEK'
+ );
- if ( $DEBUG > 2 ) {
- my $pkey = $object->primary_key;
- warn " ". scalar(@part_event).
- " possible events found for $eventtable ". $object->$pkey(). "\n";
- }
+ {
+ 'payby' => $payby2ban{$self->payby},
+ 'payinfo' => $self->payinfo,
+ #don't ever *search* on reason! #'reason' =>
+ };
+}
- push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
+sub _new_banned_pay_hashref {
+ my $self = shift;
+ my $hr = $self->_banned_pay_hashref;
+ $hr->{payinfo} = md5_base64($hr->{payinfo});
+ $hr;
+}
- }
+=item notes
- warn " ". scalar(@e_cust_event).
- " subtotal possible cust events found for $eventtable\n"
- if $DEBUG > 1;
+Returns all notes (see L<FS::cust_main_note>) for this customer.
- push @cust_event, @e_cust_event;
+=cut
- }
+sub notes {
+ my($self,$orderby_classnum) = (shift,shift);
+ my $orderby = "_DATE DESC";
+ $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
+ qsearch( 'cust_main_note',
+ { 'custnum' => $self->custnum },
+ '',
+ "ORDER BY $orderby",
+ );
+}
- warn " ". scalar(@cust_event).
- " total possible cust events found in initial search\n"
- if $DEBUG; # > 1;
+=item agent
+Returns the agent (see L<FS::agent>) for this customer.
- ##
- # test stage
- ##
+=cut
- $opt{stage} ||= 'collect';
- @cust_event =
- grep { my $stage = $_->part_event->event_stage;
- $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
- }
- @cust_event;
+sub agent {
+ my $self = shift;
+ qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
+}
- ##
- # test conditions
- ##
-
- my %unsat = ();
+=item agent_name
- @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
- 'stats_hashref' => \%unsat ),
- @cust_event;
+Returns the agent name (see L<FS::agent>) for this customer.
- warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
- if $DEBUG; # > 1;
+=cut
- warn " invalid conditions not eliminated with condition_sql:\n".
- join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
- if keys %unsat && $DEBUG; # > 1;
+sub agent_name {
+ my $self = shift;
+ $self->agent->agent;
+}
- ##
- # insert
- ##
+=item cust_tag
- unless( $opt{testonly} ) {
- foreach my $cust_event ( @cust_event ) {
+Returns any tags associated with this customer, as FS::cust_tag objects,
+or an empty list if there are no tags.
- my $error = $cust_event->insert();
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- }
- }
+=cut
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+sub cust_tag {
+ my $self = shift;
+ qsearch('cust_tag', { 'custnum' => $self->custnum } );
+}
- ##
- # return
- ##
+=item part_tag
- warn " returning events: ". Dumper(@cust_event). "\n"
- if $DEBUG > 2;
+Returns any tags associated with this customer, as FS::part_tag objects,
+or an empty list if there are no tags.
- \@cust_event;
+=cut
+sub part_tag {
+ my $self = shift;
+ map $_->part_tag, $self->cust_tag;
}
-=item retry_realtime
-Schedules realtime / batch credit card / electronic check / LEC billing
-events for for retry. Useful if card information has changed or manual
-retry is desired. The 'collect' method must be called to actually retry
-the transaction.
+=item cust_class
-Implementation details: For either this customer, or for each of this
-customer's open invoices, changes the status of the first "done" (with
-statustext error) realtime processing event to "failed".
+Returns the customer class, as an FS::cust_class object, or the empty string
+if there is no customer class.
=cut
-sub retry_realtime {
+sub cust_class {
my $self = shift;
+ if ( $self->classnum ) {
+ qsearchs('cust_class', { 'classnum' => $self->classnum } );
+ } else {
+ return '';
+ }
+}
- local $SIG{HUP} = 'IGNORE';
- local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
- local $SIG{TERM} = 'IGNORE';
- local $SIG{TSTP} = 'IGNORE';
- local $SIG{PIPE} = 'IGNORE';
+=item categoryname
- my $oldAutoCommit = $FS::UID::AutoCommit;
- local $FS::UID::AutoCommit = 0;
- my $dbh = dbh;
+Returns the customer category name, or the empty string if there is no customer
+category.
- #a little false laziness w/due_cust_event (not too bad, really)
-
- my $join = FS::part_event_condition->join_conditions_sql;
- my $order = FS::part_event_condition->order_conditions_sql;
- my $mine =
- '( '
- . join ( ' OR ' , map {
- "( part_event.eventtable = " . dbh->quote($_)
- . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
- } FS::part_event->eventtables)
- . ') ';
-
- #here is the agent virtualization
- my $agent_virt = " ( part_event.agentnum IS NULL
- OR part_event.agentnum = ". $self->agentnum. ' )';
-
- #XXX this shouldn't be hardcoded, actions should declare it...
- my @realtime_events = qw(
- cust_bill_realtime_card
- cust_bill_realtime_check
- cust_bill_realtime_lec
- cust_bill_batch
- );
+=cut
- my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
- @realtime_events
- ).
- ' ) ';
-
- my @cust_event = qsearchs({
- 'table' => 'cust_event',
- 'select' => 'cust_event.*',
- 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
- 'hashref' => { 'status' => 'done' },
- 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
- " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
- });
-
- my %seen_invnum = ();
- foreach my $cust_event (@cust_event) {
-
- #max one for the customer, one for each open invoice
- my $cust_X = $cust_event->cust_X;
- next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
- ? $cust_X->invnum
- : 0
- }++
- or $cust_event->part_event->eventtable eq 'cust_bill'
- && ! $cust_X->owed;
-
- my $error = $cust_event->retry;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error scheduling event for retry: $error";
- }
+sub categoryname {
+ my $self = shift;
+ my $cust_class = $self->cust_class;
+ $cust_class
+ ? $cust_class->categoryname
+ : '';
+}
- }
+=item classname
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
- '';
+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 BILLING METHODS
-=cut
+Documentation on billing methods has been moved to
+L<FS::cust_main::Billing>.
=item REALTIME BILLING METHODS
return '' unless $amount > 0;
my $invnum = delete $options{invnum};
- my $payby = $options{invnum} || $self->payby; #dubious
+ my $payby = $options{payby} || $self->payby; #still dubious
if ($options{'realtime'}) {
return $self->realtime_bop( FS::payby->payby2bop($self->payby),
'status' => 'O',
'payby' => FS::payby->payby2payment($payby),
);
+ $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
'custnum' => $self->custnum,
} );
- foreach (qw( address1 address2 city state zip country payby payinfo paydate
- payname )) {
+ foreach (qw( address1 address2 city state zip country latitude longitude
+ payby payinfo paydate payname ))
+ {
$options{$_} = '' unless exists($options{$_});
}
AND _date <= $time
";
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
WHERE custnum = $custnum
";
- sprintf( "%.2f", $self->scalar_sql($sql) );
+ sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
}
my $self = shift;
my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
') FROM cust_main WHERE custnum='. $self->custnum;
- sprintf( '%.2f', $self->scalar_sql($sql) );
+ sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
}
=item balance_pkgnum PKGNUM
}
}
+=item paydate_epoch
+
+Returns the exact time in seconds corresponding to the payment method
+expiration date. For CARD/DCRD customers this is the end of the month;
+for others (COMP is the only other payby that uses paydate) it's the start.
+Returns 0 if the paydate is empty or set to the far future.
+
+=cut
+
+sub paydate_epoch {
+ my $self = shift;
+ my ($month, $year) = $self->paydate_monthyear;
+ return 0 if !$year or $year >= 2037;
+ if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
+ $month++;
+ if ( $month == 13 ) {
+ $month = 1;
+ $year++;
+ }
+ return timelocal(0,0,0,1,$month-1,$year) - 1;
+ }
+ else {
+ return timelocal(0,0,0,1,$month-1,$year);
+ }
+}
+
+=item paydate_epoch_sql
+
+Class method. Returns an SQL expression to obtain the payment expiration date
+as a number of seconds.
+
+=cut
+
+# Special expiration date behavior for non-CARD/DCRD customers has been
+# carefully preserved. Do we really use that?
+sub paydate_epoch_sql {
+ my $class = shift;
+ my $table = shift || 'cust_main';
+ my ($case1, $case2);
+ if ( driver_name eq 'Pg' ) {
+ $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
+ $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
+ }
+ elsif ( lc(driver_name) eq 'mysql' ) {
+ $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
+ $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
+ }
+ else { return '' }
+ return "CASE WHEN $table.payby IN('CARD','DCRD')
+ THEN ($case1)
+ ELSE ($case2)
+ END"
+}
+
=item tax_exemption TAXNAME
=cut
sub charge_postal_fee {
my $self = shift;
- my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
+ my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
my $cust_pkg = new FS::cust_pkg ( {
$error ? $error : $cust_pkg;
}
-=item cust_bill
+=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all the invoices (see L<FS::cust_bill>) for this customer.
+Optionally, a list or hashref of additional arguments to the qsearch call can
+be passed.
+
=cut
sub cust_bill {
my $self = shift;
- map { $_ } #return $self->num_cust_bill unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ #return $self->num_cust_bill unless wantarray || keys %$opt;
+
+ $opt->{'table'} = 'cust_bill';
+ $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
+ $opt->{'hashref'}{'custnum'} = $self->custnum;
+ $opt->{'order_by'} ||= 'ORDER BY _date ASC';
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch($opt);
}
=item open_cust_bill
sub open_cust_bill {
my $self = shift;
- qsearch({
- 'table' => 'cust_bill',
- 'hashref' => { 'custnum' => $self->custnum, },
+ $self->cust_bill(
'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
- 'order_by' => 'ORDER BY _date ASC',
- });
+ #@_
+ );
+
+}
+
+=item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
+
+Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
+
+=cut
+
+sub legacy_cust_bill {
+ my $self = shift;
+
+ #return $self->num_legacy_cust_bill unless wantarray;
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch({ 'table' => 'legacy_cust_bill',
+ 'hashref' => { 'custnum' => $self->custnum, },
+ 'order_by' => 'ORDER BY _date ASC',
+ });
}
-=item cust_statements
+=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all the statements (see L<FS::cust_statement>) for this customer.
+Optionally, a list or hashref of additional arguments to the qsearch call can
+be passed.
+
=cut
sub cust_statement {
my $self = shift;
- map { $_ } #return $self->num_cust_statement unless wantarray;
- sort { $a->_date <=> $b->_date }
- qsearch('cust_statement', { 'custnum' => $self->custnum, } )
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ #return $self->num_cust_statement unless wantarray || keys %$opt;
+
+ $opt->{'table'} = 'cust_statement';
+ $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
+ $opt->{'hashref'}{'custnum'} = $self->custnum;
+ $opt->{'order_by'} ||= 'ORDER BY _date ASC';
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->_date <=> $b->_date }
+ qsearch($opt);
}
=item cust_credit
qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
}
-=item cust_pay_batch
+=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
+Optionally, a list or hashref of additional arguments to the qsearch call can
+be passed.
+
=cut
sub cust_pay_batch {
my $self = shift;
- map { $_ } #return $self->num_cust_pay_batch unless wantarray;
- sort { $a->paybatchnum <=> $b->paybatchnum }
- qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
+ my $opt = ref($_[0]) ? shift : { @_ };
+
+ #return $self->num_cust_statement unless wantarray || keys %$opt;
+
+ $opt->{'table'} = 'cust_pay_batch';
+ $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
+ $opt->{'hashref'}{'custnum'} = $self->custnum;
+ $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
+
+ map { $_ } #behavior of sort undefined in scalar context
+ sort { $a->paybatchnum <=> $b->paybatchnum }
+ qsearch($opt);
}
=item cust_pay_pending
my $self = shift;
if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
return $self->agent_custid;
+ } elsif ( $conf->config('cust_main-custnum-display_prefix') ) {
+ return $conf->config('cust_main-custnum-display_prefix').
+ sprintf('%08d', $self->custnum)
} else {
return $self->custnum;
}
=cut
-sub geocode {
- my ($self, $data_vendor) = (shift, shift); #always cch for now
-
- my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
- return $geocode if $geocode;
-
- my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
- ? 'ship_'
- : '';
-
- my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
- if $self->country eq 'US';
-
- $zip ||= '';
- $plus4 ||= '';
- #CCH specific location stuff
- my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
-
- my @cust_tax_location =
- qsearch( {
- 'table' => 'cust_tax_location',
- 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
- 'extra_sql' => $extra_sql,
- 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
- }
- );
- $geocode = $cust_tax_location[0]->geocode
- if scalar(@cust_tax_location);
-
- $geocode;
-}
-
=item cust_status
=item status
=back
+Behavior of inactive vs. cancelled edge cases can be adjusted with the
+cust_main-status_module configuration option.
+
=cut
sub status { shift->cust_status(@_); }
sub cust_status {
my $self = shift;
- # prospect ordered active inactive suspended cancelled
for my $status ( FS::cust_main->statuses() ) {
my $method = $status.'_sql';
my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
=cut
-use vars qw(%statuscolor);
-tie %statuscolor, 'Tie::IxHash',
- 'prospect' => '7e0079', #'000000', #black? naw, purple
- 'active' => '00CC00', #green
- 'ordered' => '009999', #teal? cyan?
- 'inactive' => '0000CC', #blue
- 'suspended' => 'FF9900', #yellow
- 'cancelled' => 'FF0000', #red
-;
-
sub statuscolor { shift->cust_statuscolor(@_); }
sub cust_statuscolor {
my $self = shift;
- $statuscolor{$self->cust_status};
+ __PACKAGE__->statuscolors->{$self->cust_status};
}
=item tickets
=cut
sub statuses {
- #my $self = shift; #could be class...
- keys %statuscolor;
+ my $self = shift;
+ keys %{ $self->statuscolors };
+}
+
+=item cust_status_sql
+
+Returns an SQL fragment to determine the status of a cust_main record, as a
+string.
+
+=cut
+
+sub cust_status_sql {
+ my $sql = 'CASE';
+ for my $status ( FS::cust_main->statuses() ) {
+ my $method = $status.'_sql';
+ $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
+ }
+ $sql .= ' END';
+ return $sql;
}
+
=item prospect_sql
Returns an SQL expression identifying prospective cust_main records (customers
=item ordered_sql
Returns an SQL expression identifying ordered cust_main records (customers with
-recurring packages not yet setup).
+no active packages, but recurring packages not yet setup or one time charges
+not yet billed).
=cut
sub ordered_sql {
FS::cust_main->none_active_sql.
- " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
+ " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
}
=item active_sql
=cut
-sub cancelled_sql { cancel_sql(@_); }
-sub cancel_sql {
-
- my $recurring_sql = FS::cust_pkg->recurring_sql;
- my $cancelled_sql = FS::cust_pkg->cancelled_sql;
-
- "
- 0 < ( $select_count_pkgs )
- AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
- AND 0 = ( $select_count_pkgs AND $recurring_sql
- AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
- )
- AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
- ";
-
-}
+sub cancel_sql { shift->cancelled_sql(@_); }
=item uncancel_sql
=item uncancelled_sql
=item unapplied_payments_date_sql START_TIME [ END_TIME ]
Returns an SQL fragment to retreive the total unapplied payments for this
-customer, only considering invoices with date earlier than START_TIME, and
+customer, only considering payments with date earlier than START_TIME, and
optionally not later than END_TIME.
Times are specified as SQL fragments or numeric
=over 4
-=item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
-
-=cut
-
-sub append_fuzzyfiles {
- #my( $first, $last, $company ) = @_;
-
- &check_and_rebuild_fuzzyfiles;
-
- use Fcntl qw(:flock);
-
- my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
-
- foreach my $field (@fuzzyfields) {
- my $value = shift;
-
- if ( $value ) {
-
- open(CACHE,">>$dir/cust_main.$field")
- or die "can't open $dir/cust_main.$field: $!";
- flock(CACHE,LOCK_EX)
- or die "can't lock $dir/cust_main.$field: $!";
-
- print CACHE "$value\n";
-
- flock(CACHE,LOCK_UN)
- or die "can't unlock $dir/cust_main.$field: $!";
- close CACHE;
- }
-
- }
-
- 1;
-}
-
=item batch_charge
=cut
" ORDER BY
CASE WHEN part_event_condition_option.optionname IS NULL
THEN -1
- ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
+ ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
" END
, part_event.weight".
" LIMIT 1"
sub _upgrade_data { #class method
my ($class, %opts) = @_;
- my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
- my $sth = dbh->prepare($sql) or die dbh->errstr;
- $sth->execute or die $sth->errstr;
+ my @statements = (
+ 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
+ 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL',
+ );
+ # fix yyyy-m-dd formatted paydates
+ if ( driver_name =~ /^mysql$/i ) {
+ push @statements,
+ "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
+ }
+ else { # the SQL standard
+ push @statements,
+ "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
+ }
+
+ foreach my $sql ( @statements ) {
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ }
local($ignore_expired_card) = 1;
+ local($ignore_illegal_zip) = 1;
+ local($ignore_banned_card) = 1;
local($skip_fuzzyfiles) = 1;
$class->_upgrade_otaker(%opts);
projects / freeside.git / blobdiff