X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=d9cf8686ce0bfc6e2d828c0ec07af5ad831135fe;hb=eb02bd7d44776cadc4c17f72df508afd223b142f;hp=21f66b92ed8a6564203e142011f5cbd936ed99c9;hpb=5a52da30588e8811338845ce2edaf0631acad479;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 21f66b92e..d9cf8686c 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,21 +2,21 @@ package FS::cust_main; 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::Billing FS::cust_main::Billing_Realtime FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin FS::Record ); -use vars qw( @EXPORT_OK $DEBUG $me $conf +use vars qw( $DEBUG $me $conf @encrypted_fields - $import $ignore_expired_card + $import + $ignore_expired_card $ignore_illegal_zip $ignore_banned_card $skip_fuzzyfiles @fuzzyfields @paytypes ); -use vars qw( $realtime_bop_decline_quiet ); #ugh use Carp; -use Exporter; use Scalar::Util qw( blessed ); -use List::Util qw( min ); use Time::Local qw(timelocal); use Storable qw(thaw); use MIME::Base64; @@ -26,7 +26,6 @@ use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use File::Temp qw( tempfile ); -use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); @@ -57,8 +56,6 @@ use FS::cust_tag; 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; @@ -67,10 +64,6 @@ use FS::agent_payment_gateway; use FS::banned_pay; use FS::TicketSystem; -@EXPORT_OK = qw( smart_search ); - -$realtime_bop_decline_quiet = 0; #move to Billing_Realtime - # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations # 3 is even more information including possibly sensitive data @@ -79,6 +72,8 @@ $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; +$ignore_illegal_zip = 0; +$ignore_banned_card = 0; $skip_fuzzyfiles = 0; @fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @@ -510,18 +505,12 @@ sub insert { } } - 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" @@ -644,332 +633,10 @@ sub auto_agent_custid { } -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), 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 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, I, I, -I, I, and I. - -If I 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 option is deprecated. If I is set true, no -provisioning jobs (exports) are scheduled. (You can schedule them later with -the B method for each cust_pkg object. Using the B method -on the cust_main object is not recommended, as existing services will also be -reexported.) - -If I, I, I, or I 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'}; +=item PACKAGE METHODS - foreach my $cust_pkg ( keys %$cust_pkgs ) { - - 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. =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] @@ -1748,6 +1415,7 @@ sub check { || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') || $self->ut_floatn('cdr_termination_percentage') + || $self->ut_floatn('credit_limit') ; #barf. need message catalogs. i18n. etc. @@ -1804,10 +1472,14 @@ sub check { $self->ut_phonen('daytime', $self->country) || $self->ut_phonen('night', $self->country) || $self->ut_phonen('fax', $self->country) - || $self->ut_zip('zip', $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) ) { @@ -1860,10 +1532,13 @@ sub check { $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) ; 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'); @@ -1918,12 +1593,14 @@ sub check { 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 = 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. ')'; + } } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { @@ -2118,38 +1795,6 @@ sub location_hash { #fields that cust_location has } -=item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] - -Returns all packages (see L) for this customer. - -=cut - -sub all_pkgs { - 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; -} - -=item cust_pkg - -Synonym for B. - -=cut - -sub cust_pkg { - shift->all_pkgs(@_); -} - =item cust_location Returns all locations (see L) for this customer. @@ -2216,244 +1861,84 @@ sub location_label { $line; } -=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] +=item unsuspend -Returns all non-cancelled packages (see L) for this customer. +Unsuspends all unflagged suspended packages (see L +and L) for this customer. Always returns a list: an empty list +on success or a list of errors. =cut -sub ncancelled_pkgs { +sub unsuspend { 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 ) '; + grep { $_->unsuspend } $self->suspended_pkgs; +} - @cust_pkg = $self->_cust_pkg($extra_qsearch); +=item suspend - } +Suspends all unsuspended packages (see L) for this customer. - sort sort_packages @cust_pkg; +Returns a list: an empty list on success or a list of errors. -} +=cut -sub _cust_pkg { +sub suspend { 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 }, - }); - + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -# 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 suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -} +Suspends all unsuspended packages (see L) matching the listed +PKGPARTs (see L). Preferred usage is to pass a hashref instead +of a list of pkgparts; the hashref has the following keys: -=item suspended_pkgs +=over 4 -Returns all suspended packages (see L) for this customer. +=item pkgparts - listref of pkgparts -=cut +=item (other options are passed to the suspend method) -sub suspended_pkgs { - my $self = shift; - grep { $_->susp } $self->ncancelled_pkgs; -} +=back -=item unflagged_suspended_pkgs -Returns all unflagged suspended packages (see L) for this -customer (thouse packages without the `manual_flag' set). +Returns a list: an empty list on success or a list of errors. =cut -sub unflagged_suspended_pkgs { +sub suspend_if_pkgpart { my $self = shift; - return $self->suspended_pkgs - unless dbdef->table('cust_pkg')->column('manual_flag'); - grep { ! $_->manual_flag } $self->suspended_pkgs; + my (@pkgparts, %opt); + if (ref($_[0]) eq 'HASH'){ + @pkgparts = @{$_[0]{pkgparts}}; + %opt = %{$_[0]}; + }else{ + @pkgparts = @_; + } + grep { $_->suspend(%opt) } + grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; } -=item unsuspended_pkgs +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] -Returns all unsuspended (and uncancelled) packages (see L) for -this customer. +Suspends all unsuspended packages (see L) unless they match the +given PKGPARTs (see L). Preferred usage is to pass a hashref +instead of a list of pkgparts; the hashref has the following keys: -=cut +=over 4 -sub unsuspended_pkgs { - my $self = shift; - grep { ! $_->susp } $self->ncancelled_pkgs; -} +=item pkgparts - listref of pkgparts + +=item (other options are passed to the suspend method) -=item next_bill_date +=back -Returns the next date this customer will be billed, as a UNIX timestamp, or -undef if no active package has a next bill date. +Returns a list: an empty list on success or a list of errors. =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) 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 -and L) 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) 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) matching the listed -PKGPARTs (see L). 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 { - my $self = shift; - my (@pkgparts, %opt); - if (ref($_[0]) eq 'HASH'){ - @pkgparts = @{$_[0]{pkgparts}}; - %opt = %{$_[0]}; - }else{ - @pkgparts = @_; - } - grep { $_->suspend(%opt) } - grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } - $self->unsuspended_pkgs; -} - -=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] - -Suspends all unsuspended packages (see L) unless they match the -given PKGPARTs (see L). 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_unless_pkgpart { +sub suspend_unless_pkgpart { my $self = shift; my (@pkgparts, %opt); if (ref($_[0]) eq 'HASH'){ @@ -2661,2681 +2146,1644 @@ sub classname { Documentation on billing methods has been moved to L. -=item do_cust_event [ HASHREF | OPTION => VALUE ... ] - -Runs billing events; see L and the billing events web -interface. +=item REALTIME BILLING METHODS -If there is an error, returns the error, otherwise returns false. +Documentation on realtime billing methods has been moved to +L. -Options are passed as name-value pairs. +=item remove_cvv -Currently available options are: +Removes the I field from the database directly. -=over 4 +If there is an error, returns the error, otherwise returns false. -=item time +=cut -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). Also see L and L for conversion functions. +sub remove_cvv { + my $self = shift; + my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") + or return dbh->errstr; + $sth->execute($self->custnum) + or return $sth->errstr; + $self->paycvv(''); + ''; +} -=item check_freq +=item batch_card OPTION => VALUE... -"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) +Adds a payment for this invoice to the pending credit card batch (see +L), or, if the B option is set to a true value, +runs the payment using a realtime gateway. -=item stage +=cut -"collect" (the default) or "pre-bill" +sub batch_card { + my ($self, %options) = @_; -=item quiet - -set true to surpress email card/ACH decline notices. + my $amount; + if (exists($options{amount})) { + $amount = $options{amount}; + }else{ + $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); + } + return '' unless $amount > 0; + + my $invnum = delete $options{invnum}; + my $payby = $options{payby} || $self->payby; #still dubious -=item debug + if ($options{'realtime'}) { + return $self->realtime_bop( FS::payby->payby2bop($self->payby), + $amount, + %options, + ); + } -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) + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; -=cut + #this needs to handle mysql as well as Pg, like svc_acct.pm + #(make it into a common function if folks need to do batching with mysql) + $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE") + or return "Cannot lock pay_batch: " . $dbh->errstr; -# =item payby -# -# allows for one time override of normal customer billing method + my %pay_batch = ( + 'status' => 'O', + 'payby' => FS::payby->payby2payment($payby), + ); -# =item retry -# -# Retry card/echeck/LEC transactions even when not scheduled by invoice events. + my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); -sub do_cust_event { - my( $self, %options ) = @_; - my $time = $options{'time'} || time; + unless ( $pay_batch ) { + $pay_batch = new FS::pay_batch \%pay_batch; + my $error = $pay_batch->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + die "error creating new batch: $error\n"; + } + } - #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 $old_cust_pay_batch = qsearchs('cust_pay_batch', { + 'batchnum' => $pay_batch->batchnum, + 'custnum' => $self->custnum, + } ); - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + foreach (qw( address1 address2 city state zip country payby payinfo paydate + payname )) { + $options{$_} = '' unless exists($options{$_}); + } - $self->select_for_update; #mutex + my $cust_pay_batch = new FS::cust_pay_batch ( { + 'batchnum' => $pay_batch->batchnum, + 'invnum' => $invnum || 0, # is there a better value? + # this field should be + # removed... + # cust_bill_pay_batch now + 'custnum' => $self->custnum, + 'last' => $self->getfield('last'), + 'first' => $self->getfield('first'), + 'address1' => $options{address1} || $self->address1, + 'address2' => $options{address2} || $self->address2, + 'city' => $options{city} || $self->city, + 'state' => $options{state} || $self->state, + 'zip' => $options{zip} || $self->zip, + 'country' => $options{country} || $self->country, + 'payby' => $options{payby} || $self->payby, + 'payinfo' => $options{payinfo} || $self->payinfo, + 'exp' => $options{paydate} || $self->paydate, + 'payname' => $options{payname} || $self->payname, + 'amount' => $amount, # consolidating + } ); + + $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) + if $old_cust_pay_batch; - if ( $DEBUG ) { - my $balance = $self->balance; - warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n" + my $error; + if ($old_cust_pay_batch) { + $error = $cust_pay_batch->replace($old_cust_pay_batch) + } else { + $error = $cust_pay_batch->insert; } -# 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) ) { + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $due_cust_event; + die $error; } - $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; + my $unapplied = $self->total_unapplied_credits + + $self->total_unapplied_payments + + $self->in_transit_payments; + foreach my $cust_bill ($self->open_cust_bill) { + #$dbh->commit or die $dbh->errstr if $oldAutoCommit; + my $cust_bill_pay_batch = new FS::cust_bill_pay_batch { + 'invnum' => $cust_bill->invnum, + 'paybatchnum' => $cust_pay_batch->paybatchnum, + 'amount' => $cust_bill->owed, + '_date' => time, + }; + if ($unapplied >= $cust_bill_pay_batch->amount){ + $unapplied -= $cust_bill_pay_batch->amount; next; + }else{ + $cust_bill_pay_batch->amount(sprintf ( "%.2f", + $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0; } - - { - 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; - } + $error = $cust_bill_pay_batch->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + die $error; } - } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; - } -=item due_cust_event [ HASHREF | OPTION => VALUE ... ] +=item total_owed -Inserts database records for and returns an ordered listref of new events due -for this customer, as FS::cust_event objects (see L). If no -events are due, an empty listref is returned. If there is an error, returns a -scalar error message. +Returns the total owed for this customer on all invoices +(see L). -To actually run the events, call each event's test_condition method, and if -still true, call the event's do_event method. +=cut -Options are passed as a hashref or as a list of name-value pairs. Available -options are: +sub total_owed { + my $self = shift; + $self->total_owed_date(2145859200); #12/31/2037 +} -=over 4 +=item total_owed_date TIME -=item check_freq +Returns the total owed for this customer on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. -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. +=cut -=item stage +sub total_owed_date { + my $self = shift; + my $time = shift; -"collect" (the default) or "pre-bill" + my $custnum = $self->custnum; -=item time - -"Current time" for the events. + my $owed_sql = FS::cust_bill->owed_sql; -=item debug + my $sql = " + SELECT SUM($owed_sql) FROM cust_bill + WHERE custnum = $custnum + AND _date <= $time + "; -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) + sprintf( "%.2f", $self->scalar_sql($sql) ); -=item eventtable +} -Only return events for the specified eventtable (by default, events of all eventtables are returned) +=item total_owed_pkgnum PKGNUM -=item objects +Returns the total owed on all invoices for this customer's specific package +when using experimental package balances (see L). -Explicitly pass the objects to be tested (typically used with eventtable). +=cut -=item testonly +sub total_owed_pkgnum { + my( $self, $pkgnum ) = @_; + $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037 +} -Set to true to return the objects, but not actually insert them into the -database. +=item total_owed_date_pkgnum TIME PKGNUM -=back +Returns the total owed for this customer's specific package when using +experimental package balances on all invoices with date earlier than +TIME. TIME is specified as a UNIX timestamp; see L). Also +see L and L for conversion functions. =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; +sub total_owed_date_pkgnum { + my( $self, $time, $pkgnum ) = @_; - warn "$me due_cust_event called with options ". - join(', ', map { "$_: $opt{$_}" } keys %opt). "\n" - if $DEBUG; + my $total_bill = 0; + foreach my $cust_bill ( + grep { $_->_date <= $time } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) + ) { + $total_bill += $cust_bill->owed_pkgnum($pkgnum); + } + sprintf( "%.2f", $total_bill ); - $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 total_paid - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +Returns the total amount of all payments. - $self->select_for_update #mutex - unless $opt{testonly}; +=cut - ### - # find possible events (initial search) - ### - - my @cust_event = (); +sub total_paid { + my $self = shift; + my $total = 0; + $total += $_->paid foreach $self->cust_pay; + sprintf( "%.2f", $total ); +} - my @eventtable = $opt{'eventtable'} - ? ( $opt{'eventtable'} ) - : FS::part_event->eventtables_runorder; +=item total_unapplied_credits - foreach my $eventtable ( @eventtable ) { +Returns the total outstanding credit (see L) for this +customer. See L. - my @objects; - if ( $opt{'objects'} ) { +=item total_credited - @objects = @{ $opt{'objects'} }; +Old name for total_unapplied_credits. Don't use. - } else { +=cut - #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; } - @objects = ( $eventtable eq 'cust_main' ) - ? ( $self ) - : ( $self->$eventtable() ); +sub total_credited { + #carp "total_credited deprecated, use total_unapplied_credits"; + shift->total_unapplied_credits(@_); +} - } +sub total_unapplied_credits { + my $self = shift; - my @e_cust_event = (); + my $custnum = $self->custnum; - my $cross = "CROSS JOIN $eventtable"; - $cross .= ' LEFT JOIN cust_main USING ( custnum )' - unless $eventtable eq 'cust_main'; + my $unapplied_sql = FS::cust_credit->unapplied_sql; - foreach my $object ( @objects ) { + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_credit + WHERE custnum = $custnum + "; - #this first search uses the condition_sql magic for optimization. - #the more possible events we can eliminate in this step the better + sprintf( "%.2f", $self->scalar_sql($sql) ); - my $cross_where = ''; - my $pkey = $object->primary_key; - $cross_where = "$eventtable.$pkey = ". $object->$pkey(); +} - 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 ); +=item total_unapplied_credits_pkgnum PKGNUM - $extra_sql = "AND $extra_sql" if $extra_sql; +Returns the total outstanding credit (see L) for this +customer. See L. - #here is the agent virtualization - $extra_sql .= " AND ( part_event.agentnum IS NULL - OR part_event.agentnum = ". $self->agentnum. ' )'; +=cut - $extra_sql .= " $order"; +sub total_unapplied_credits_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_credit = 0; + $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum); + sprintf( "%.2f", $total_credit ); +} - 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", - } ); - if ( $DEBUG > 2 ) { - my $pkey = $object->primary_key; - warn " ". scalar(@part_event). - " possible events found for $eventtable ". $object->$pkey(). "\n"; - } +=item total_unapplied_payments - push @e_cust_event, map { $_->new_cust_event($object) } @part_event; +Returns the total unapplied payments (see L) for this customer. +See L. - } +=cut - warn " ". scalar(@e_cust_event). - " subtotal possible cust events found for $eventtable\n" - if $DEBUG > 1; +sub total_unapplied_payments { + my $self = shift; - push @cust_event, @e_cust_event; + my $custnum = $self->custnum; - } + my $unapplied_sql = FS::cust_pay->unapplied_sql; - warn " ". scalar(@cust_event). - " total possible cust events found in initial search\n" - if $DEBUG; # > 1; + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_pay + WHERE custnum = $custnum + "; + sprintf( "%.2f", $self->scalar_sql($sql) ); - ## - # test stage - ## +} - $opt{stage} ||= 'collect'; - @cust_event = - grep { my $stage = $_->part_event->event_stage; - $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' ) - } - @cust_event; +=item total_unapplied_payments_pkgnum PKGNUM - ## - # test conditions - ## - - my %unsat = (); +Returns the total unapplied payments (see L) for this customer's +specific package when using experimental package balances. See +L. - @cust_event = grep $_->test_conditions( 'time' => $opt{'time'}, - 'stats_hashref' => \%unsat ), - @cust_event; +=cut - warn " ". scalar(@cust_event). " cust events left satisfying conditions\n" - if $DEBUG; # > 1; +sub total_unapplied_payments_pkgnum { + my( $self, $pkgnum ) = @_; + my $total_unapplied = 0; + $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum); + sprintf( "%.2f", $total_unapplied ); +} - warn " invalid conditions not eliminated with condition_sql:\n". - join('', map " $_: ".$unsat{$_}."\n", keys %unsat ) - if keys %unsat && $DEBUG; # > 1; - ## - # insert - ## +=item total_unapplied_refunds - unless( $opt{testonly} ) { - foreach my $cust_event ( @cust_event ) { +Returns the total unrefunded refunds (see L) for this +customer. See L. - my $error = $cust_event->insert(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } - } +=cut - $dbh->commit or die $dbh->errstr if $oldAutoCommit; +sub total_unapplied_refunds { + my $self = shift; + my $custnum = $self->custnum; - ## - # return - ## + my $unapplied_sql = FS::cust_refund->unapplied_sql; - warn " returning events: ". Dumper(@cust_event). "\n" - if $DEBUG > 2; + my $sql = " + SELECT SUM($unapplied_sql) FROM cust_refund + WHERE custnum = $custnum + "; - \@cust_event; + sprintf( "%.2f", $self->scalar_sql($sql) ); } -=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 balance -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 balance for this customer (total_owed plus total_unrefunded, minus +total_unapplied_credits minus total_unapplied_payments). =cut -sub retry_realtime { +sub balance { my $self = shift; + $self->balance_date_range; +} - 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; - - #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 - ); - - 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"; - } +=item balance_date TIME - } +Returns the balance for this customer, only considering invoices with date +earlier than TIME (total_owed_date minus total_credited minus +total_unapplied_payments). TIME is specified as a UNIX timestamp; see +L). Also see L and L for conversion +functions. - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; +=cut +sub balance_date { + my $self = shift; + $self->balance_date_range(shift); } +=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] -=cut +Returns the balance for this customer, optionally considering invoices with +date earlier than START_TIME, and not later than END_TIME +(total_owed_date minus total_unapplied_credits minus total_unapplied_payments). -=item REALTIME BILLING METHODS +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. -Documentation on realtime billing methods has been moved to -L. +Available options are: -=item remove_cvv +=over 4 -Removes the I field from the database directly. +=item unapplied_date -If there is an error, returns the error, otherwise returns false. +set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) + +=back =cut -sub remove_cvv { +sub balance_date_range { my $self = shift; - my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?") - or return dbh->errstr; - $sth->execute($self->custnum) - or return $sth->errstr; - $self->paycvv(''); - ''; + my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). + ') FROM cust_main WHERE custnum='. $self->custnum; + sprintf( '%.2f', $self->scalar_sql($sql) ); } -=item batch_card OPTION => VALUE... +=item balance_pkgnum PKGNUM -Adds a payment for this invoice to the pending credit card batch (see -L), or, if the B option is set to a true value, -runs the payment using a realtime gateway. +Returns the balance for this customer's specific package when using +experimental package balances (total_owed plus total_unrefunded, minus +total_unapplied_credits minus total_unapplied_payments) =cut -sub batch_card { - my ($self, %options) = @_; +sub balance_pkgnum { + my( $self, $pkgnum ) = @_; - my $amount; - if (exists($options{amount})) { - $amount = $options{amount}; - }else{ - $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); - } - return '' unless $amount > 0; - - my $invnum = delete $options{invnum}; - my $payby = $options{invnum} || $self->payby; #dubious + sprintf( "%.2f", + $self->total_owed_pkgnum($pkgnum) +# n/a - refunds aren't part of pkg-balances since they don't apply to invoices +# + $self->total_unapplied_refunds_pkgnum($pkgnum) + - $self->total_unapplied_credits_pkgnum($pkgnum) + - $self->total_unapplied_payments_pkgnum($pkgnum) + ); +} - if ($options{'realtime'}) { - return $self->realtime_bop( FS::payby->payby2bop($self->payby), - $amount, - %options, - ); - } +=item in_transit_payments - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; +Returns the total of requests for payments for this customer pending in +batches in transit to the bank. See L and L - #this needs to handle mysql as well as Pg, like svc_acct.pm - #(make it into a common function if folks need to do batching with mysql) - $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE") - or return "Cannot lock pay_batch: " . $dbh->errstr; +=cut - my %pay_batch = ( - 'status' => 'O', - 'payby' => FS::payby->payby2payment($payby), - ); - - my $pay_batch = qsearchs( 'pay_batch', \%pay_batch ); - - unless ( $pay_batch ) { - $pay_batch = new FS::pay_batch \%pay_batch; - my $error = $pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die "error creating new batch: $error\n"; +sub in_transit_payments { + my $self = shift; + my $in_transit_payments = 0; + foreach my $pay_batch ( qsearch('pay_batch', { + 'status' => 'I', + } ) ) { + foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { + 'batchnum' => $pay_batch->batchnum, + 'custnum' => $self->custnum, + } ) ) { + $in_transit_payments += $cust_pay_batch->amount; } } + sprintf( "%.2f", $in_transit_payments ); +} - my $old_cust_pay_batch = qsearchs('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ); +=item payment_info - foreach (qw( address1 address2 city state zip country payby payinfo paydate - payname )) { - $options{$_} = '' unless exists($options{$_}); - } +Returns a hash of useful information for making a payment. - my $cust_pay_batch = new FS::cust_pay_batch ( { - 'batchnum' => $pay_batch->batchnum, - 'invnum' => $invnum || 0, # is there a better value? - # this field should be - # removed... - # cust_bill_pay_batch now - 'custnum' => $self->custnum, - 'last' => $self->getfield('last'), - 'first' => $self->getfield('first'), - 'address1' => $options{address1} || $self->address1, - 'address2' => $options{address2} || $self->address2, - 'city' => $options{city} || $self->city, - 'state' => $options{state} || $self->state, - 'zip' => $options{zip} || $self->zip, - 'country' => $options{country} || $self->country, - 'payby' => $options{payby} || $self->payby, - 'payinfo' => $options{payinfo} || $self->payinfo, - 'exp' => $options{paydate} || $self->paydate, - 'payname' => $options{payname} || $self->payname, - 'amount' => $amount, # consolidating - } ); - - $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) - if $old_cust_pay_batch; +=over 4 - my $error; - if ($old_cust_pay_batch) { - $error = $cust_pay_batch->replace($old_cust_pay_batch) - } else { - $error = $cust_pay_batch->insert; - } +=item balance - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error; - } +Current balance. - my $unapplied = $self->total_unapplied_credits - + $self->total_unapplied_payments - + $self->in_transit_payments; - foreach my $cust_bill ($self->open_cust_bill) { - #$dbh->commit or die $dbh->errstr if $oldAutoCommit; - my $cust_bill_pay_batch = new FS::cust_bill_pay_batch { - 'invnum' => $cust_bill->invnum, - 'paybatchnum' => $cust_pay_batch->paybatchnum, - 'amount' => $cust_bill->owed, - '_date' => time, - }; - if ($unapplied >= $cust_bill_pay_batch->amount){ - $unapplied -= $cust_bill_pay_batch->amount; - next; - }else{ - $cust_bill_pay_batch->amount(sprintf ( "%.2f", - $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0; - } - $error = $cust_bill_pay_batch->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $error; - } - } +=item payby - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; -} +'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand), +'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand), +'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free). -=item total_owed +=back -Returns the total owed for this customer on all invoices -(see L). +For credit card transactions: -=cut +=over 4 -sub total_owed { - my $self = shift; - $self->total_owed_date(2145859200); #12/31/2037 -} +=item card_type 1 -=item total_owed_date TIME +=item payname -Returns the total owed for this customer on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L). Also -see L and L for conversion functions. +Exact name on card -=cut +=back -sub total_owed_date { - my $self = shift; - my $time = shift; +For electronic check transactions: - my $custnum = $self->custnum; +=over 4 - my $owed_sql = FS::cust_bill->owed_sql; +=item stateid_state - my $sql = " - SELECT SUM($owed_sql) FROM cust_bill - WHERE custnum = $custnum - AND _date <= $time - "; +=back - sprintf( "%.2f", $self->scalar_sql($sql) ); +=cut -} +sub payment_info { + my $self = shift; -=item total_owed_pkgnum PKGNUM + my %return = (); -Returns the total owed on all invoices for this customer's specific package -when using experimental package balances (see L). + $return{balance} = $self->balance; -=cut + $return{payname} = $self->payname + || ( $self->first. ' '. $self->get('last') ); -sub total_owed_pkgnum { - my( $self, $pkgnum ) = @_; - $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037 -} + $return{$_} = $self->get($_) for qw(address1 address2 city state zip); -=item total_owed_date_pkgnum TIME PKGNUM + $return{payby} = $self->payby; + $return{stateid_state} = $self->stateid_state; -Returns the total owed for this customer's specific package when using -experimental package balances on all invoices with date earlier than -TIME. TIME is specified as a UNIX timestamp; see L). Also -see L and L for conversion functions. + if ( $self->payby =~ /^(CARD|DCRD)$/ ) { + $return{card_type} = cardtype($self->payinfo); + $return{payinfo} = $self->paymask; -=cut + @return{'month', 'year'} = $self->paydate_monthyear; -sub total_owed_date_pkgnum { - my( $self, $time, $pkgnum ) = @_; + } + + if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { + my ($payinfo1, $payinfo2) = split '@', $self->paymask; + $return{payinfo1} = $payinfo1; + $return{payinfo2} = $payinfo2; + $return{paytype} = $self->paytype; + $return{paystate} = $self->paystate; - my $total_bill = 0; - foreach my $cust_bill ( - grep { $_->_date <= $time } - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { - $total_bill += $cust_bill->owed_pkgnum($pkgnum); } - sprintf( "%.2f", $total_bill ); + + #doubleclick protection + my $_date = time; + $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; + + %return; } -=item total_paid +=item paydate_monthyear -Returns the total amount of all payments. +Returns a two-element list consisting of the month and year of this customer's +paydate (credit card expiration date for CARD customers) =cut -sub total_paid { +sub paydate_monthyear { my $self = shift; - my $total = 0; - $total += $_->paid foreach $self->cust_pay; - sprintf( "%.2f", $total ); + if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format + ( $2, $1 ); + } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { + ( $1, $3 ); + } else { + ('', ''); + } } -=item total_unapplied_credits - -Returns the total outstanding credit (see L) for this -customer. See L. - -=item total_credited - -Old name for total_unapplied_credits. Don't use. +=item tax_exemption TAXNAME =cut -sub total_credited { - #carp "total_credited deprecated, use total_unapplied_credits"; - shift->total_unapplied_credits(@_); +sub tax_exemption { + my( $self, $taxname ) = @_; + + qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum, + 'taxname' => $taxname, + }, + ); } -sub total_unapplied_credits { - my $self = shift; +=item cust_main_exemption - my $custnum = $self->custnum; +=cut - my $unapplied_sql = FS::cust_credit->unapplied_sql; +sub cust_main_exemption { + my $self = shift; + qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ); +} - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_credit - WHERE custnum = $custnum - "; +=item invoicing_list [ ARRAYREF ] - sprintf( "%.2f", $self->scalar_sql($sql) ); +If an arguement is given, sets these email addresses as invoice recipients +(see L). Errors are not fatal and are not reported +(except as warnings), so use check_invoicing_list first. -} +Returns a list of email addresses (with svcnum entries expanded). -=item total_unapplied_credits_pkgnum PKGNUM +Note: You can clear the invoicing list by passing an empty ARRAYREF. You can +check it without disturbing anything by passing nothing. -Returns the total outstanding credit (see L) for this -customer. See L. +This interface may change in the future. =cut -sub total_unapplied_credits_pkgnum { - my( $self, $pkgnum ) = @_; - my $total_credit = 0; - $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum); - sprintf( "%.2f", $total_credit ); -} +sub invoicing_list { + my( $self, $arrayref ) = @_; + + if ( $arrayref ) { + my @cust_main_invoice; + if ( $self->custnum ) { + @cust_main_invoice = + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + @cust_main_invoice = (); + } + foreach my $cust_main_invoice ( @cust_main_invoice ) { + #warn $cust_main_invoice->destnum; + unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) { + #warn $cust_main_invoice->destnum; + my $error = $cust_main_invoice->delete; + warn $error if $error; + } + } + if ( $self->custnum ) { + @cust_main_invoice = + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + @cust_main_invoice = (); + } + my %seen = map { $_->address => 1 } @cust_main_invoice; + foreach my $address ( @{$arrayref} ) { + next if exists $seen{$address} && $seen{$address}; + $seen{$address} = 1; + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $cust_main_invoice->insert; + warn $error if $error; + } + } + + if ( $self->custnum ) { + map { $_->address } + qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { + (); + } +} -=item total_unapplied_payments +=item check_invoicing_list ARRAYREF -Returns the total unapplied payments (see L) for this customer. -See L. +Checks these arguements as valid input for the invoicing_list method. If there +is an error, returns the error, otherwise returns false. =cut -sub total_unapplied_payments { - my $self = shift; +sub check_invoicing_list { + my( $self, $arrayref ) = @_; - my $custnum = $self->custnum; + foreach my $address ( @$arrayref ) { - my $unapplied_sql = FS::cust_pay->unapplied_sql; + if ($address eq 'FAX' and $self->getfield('fax') eq '') { + return 'Can\'t add FAX invoice destination with a blank FAX number.'; + } - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_pay - WHERE custnum = $custnum - "; + my $cust_main_invoice = new FS::cust_main_invoice ( { + 'custnum' => $self->custnum, + 'dest' => $address, + } ); + my $error = $self->custnum + ? $cust_main_invoice->check + : $cust_main_invoice->checkdest + ; + return $error if $error; - sprintf( "%.2f", $self->scalar_sql($sql) ); + } + + return "Email address required" + if $conf->exists('cust_main-require_invoicing_list_email') + && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref; + ''; } -=item total_unapplied_payments_pkgnum PKGNUM +=item set_default_invoicing_list -Returns the total unapplied payments (see L) for this customer's -specific package when using experimental package balances. See -L. +Sets the invoicing list to all accounts associated with this customer, +overwriting any previous invoicing list. =cut -sub total_unapplied_payments_pkgnum { - my( $self, $pkgnum ) = @_; - my $total_unapplied = 0; - $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum); - sprintf( "%.2f", $total_unapplied ); +sub set_default_invoicing_list { + my $self = shift; + $self->invoicing_list($self->all_emails); } +=item all_emails -=item total_unapplied_refunds +Returns the email addresses of all accounts provisioned for this customer. -Returns the total unrefunded refunds (see L) for this -customer. See L. +=cut + +sub all_emails { + my $self = shift; + my %list; + foreach my $cust_pkg ( $self->all_pkgs ) { + my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); + my @svc_acct = + map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + @cust_svc; + $list{$_}=1 foreach map { $_->email } @svc_acct; + } + keys %list; +} + +=item invoicing_list_addpost + +Adds postal invoicing to this customer. If this customer is already configured +to receive postal invoices, does nothing. =cut -sub total_unapplied_refunds { +sub invoicing_list_addpost { my $self = shift; - my $custnum = $self->custnum; + return if grep { $_ eq 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list; + push @invoicing_list, 'POST'; + $self->invoicing_list(\@invoicing_list); +} - my $unapplied_sql = FS::cust_refund->unapplied_sql; +=item invoicing_list_emailonly - my $sql = " - SELECT SUM($unapplied_sql) FROM cust_refund - WHERE custnum = $custnum - "; +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX). - sprintf( "%.2f", $self->scalar_sql($sql) ); +=cut +sub invoicing_list_emailonly { + my $self = shift; + warn "$me invoicing_list_emailonly called" + if $DEBUG; + grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; } -=item balance +=item invoicing_list_emailonly_scalar -Returns the balance for this customer (total_owed plus total_unrefunded, minus -total_unapplied_credits minus total_unapplied_payments). +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX) as a comma-separated scalar. =cut -sub balance { +sub invoicing_list_emailonly_scalar { my $self = shift; - $self->balance_date_range; + warn "$me invoicing_list_emailonly_scalar called" + if $DEBUG; + join(', ', $self->invoicing_list_emailonly); } -=item balance_date TIME +=item referral_custnum_cust_main -Returns the balance for this customer, only considering invoices with date -earlier than TIME (total_owed_date minus total_credited minus -total_unapplied_payments). TIME is specified as a UNIX timestamp; see -L). Also see L and L for conversion -functions. +Returns the customer who referred this customer (or the empty string, if +this customer was not referred). + +Note the difference with referral_cust_main method: This method, +referral_custnum_cust_main returns the single customer (if any) who referred +this customer, while referral_cust_main returns an array of customers referred +BY this customer. =cut -sub balance_date { +sub referral_custnum_cust_main { my $self = shift; - $self->balance_date_range(shift); + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); } -=item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] +=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] -Returns the balance for this customer, optionally considering invoices with -date earlier than START_TIME, and not later than END_TIME -(total_owed_date minus total_unapplied_credits minus total_unapplied_payments). +Returns an array of customers referred by this customer (referral_custnum set +to this custnum). If DEPTH is given, recurses up to the given depth, returning +customers referred by customers referred by this customer and so on, inclusive. +The default behavior is DEPTH 1 (no recursion). -Times are specified as SQL fragments or numeric -UNIX timestamps; see L). Also see L and -L for conversion functions. The empty string can be passed -to disable that time constraint completely. +Note the difference with referral_custnum_cust_main method: This method, +referral_cust_main, returns an array of customers referred BY this customer, +while referral_custnum_cust_main returns the single customer (if any) who +referred this customer. -Available options are: +=cut -=over 4 +sub referral_cust_main { + my $self = shift; + my $depth = @_ ? shift : 1; + my $exclude = @_ ? shift : {}; -=item unapplied_date + my @cust_main = + map { $exclude->{$_->custnum}++; $_; } + grep { ! $exclude->{ $_->custnum } } + qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } ); -set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) + if ( $depth > 1 ) { + push @cust_main, + map { $_->referral_cust_main($depth-1, $exclude) } + @cust_main; + } -=back + @cust_main; +} + +=item referral_cust_main_ncancelled + +Same as referral_cust_main, except only returns customers with uncancelled +packages. =cut -sub balance_date_range { +sub referral_cust_main_ncancelled { my $self = shift; - my $sql = 'SELECT SUM('. $self->balance_date_sql(@_). - ') FROM cust_main WHERE custnum='. $self->custnum; - sprintf( '%.2f', $self->scalar_sql($sql) ); + grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main; } -=item balance_pkgnum PKGNUM +=item referral_cust_pkg [ DEPTH ] -Returns the balance for this customer's specific package when using -experimental package balances (total_owed plus total_unrefunded, minus -total_unapplied_credits minus total_unapplied_payments) +Like referral_cust_main, except returns a flat list of all unsuspended (and +uncancelled) packages for each customer. The number of items in this list may +be useful for commission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). =cut -sub balance_pkgnum { - my( $self, $pkgnum ) = @_; +sub referral_cust_pkg { + my $self = shift; + my $depth = @_ ? shift : 1; - sprintf( "%.2f", - $self->total_owed_pkgnum($pkgnum) -# n/a - refunds aren't part of pkg-balances since they don't apply to invoices -# + $self->total_unapplied_refunds_pkgnum($pkgnum) - - $self->total_unapplied_credits_pkgnum($pkgnum) - - $self->total_unapplied_payments_pkgnum($pkgnum) - ); + map { $_->unsuspended_pkgs } + grep { $_->unsuspended_pkgs } + $self->referral_cust_main($depth); } -=item in_transit_payments +=item referring_cust_main -Returns the total of requests for payments for this customer pending in -batches in transit to the bank. See L and L +Returns the single cust_main record for the customer who referred this customer +(referral_custnum), or false. =cut -sub in_transit_payments { - my $self = shift; - my $in_transit_payments = 0; - foreach my $pay_batch ( qsearch('pay_batch', { - 'status' => 'I', - } ) ) { - foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { - 'batchnum' => $pay_batch->batchnum, - 'custnum' => $self->custnum, - } ) ) { - $in_transit_payments += $cust_pay_batch->amount; - } - } - sprintf( "%.2f", $in_transit_payments ); -} - -=item payment_info - -Returns a hash of useful information for making a payment. - -=over 4 - -=item balance - -Current balance. - -=item payby - -'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand), -'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand), -'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free). - -=back - -For credit card transactions: - -=over 4 - -=item card_type 1 - -=item payname - -Exact name on card - -=back - -For electronic check transactions: - -=over 4 - -=item stateid_state - -=back - -=cut - -sub payment_info { - my $self = shift; - - my %return = (); - - $return{balance} = $self->balance; - - $return{payname} = $self->payname - || ( $self->first. ' '. $self->get('last') ); - - $return{$_} = $self->get($_) for qw(address1 address2 city state zip); - - $return{payby} = $self->payby; - $return{stateid_state} = $self->stateid_state; - - if ( $self->payby =~ /^(CARD|DCRD)$/ ) { - $return{card_type} = cardtype($self->payinfo); - $return{payinfo} = $self->paymask; - - @return{'month', 'year'} = $self->paydate_monthyear; - - } - - if ( $self->payby =~ /^(CHEK|DCHK)$/ ) { - my ($payinfo1, $payinfo2) = split '@', $self->paymask; - $return{payinfo1} = $payinfo1; - $return{payinfo2} = $payinfo2; - $return{paytype} = $self->paytype; - $return{paystate} = $self->paystate; - - } - - #doubleclick protection - my $_date = time; - $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32; - - %return; - -} - -=item paydate_monthyear - -Returns a two-element list consisting of the month and year of this customer's -paydate (credit card expiration date for CARD customers) - -=cut - -sub paydate_monthyear { +sub referring_cust_main { my $self = shift; - if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format - ( $2, $1 ); - } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) { - ( $1, $3 ); - } else { - ('', ''); - } + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); } -=item tax_exemption TAXNAME +=item credit AMOUNT, REASON [ , OPTION => VALUE ... ] -=cut +Applies a credit to this customer. If there is an error, returns the error, +otherwise returns false. -sub tax_exemption { - my( $self, $taxname ) = @_; +REASON can be a text string, an FS::reason object, or a scalar reference to +a reasonnum. If a text string, it will be automatically inserted as a new +reason, and a 'reason_type' option must be passed to indicate the +FS::reason_type for the new reason. - qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum, - 'taxname' => $taxname, - }, - ); -} +An I option may be passed to set the credit's I field. -=item cust_main_exemption +Any other options are passed to FS::cust_credit::insert. =cut -sub cust_main_exemption { - my $self = shift; - qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ); -} - -=item invoicing_list [ ARRAYREF ] - -If an arguement is given, sets these email addresses as invoice recipients -(see L). Errors are not fatal and are not reported -(except as warnings), so use check_invoicing_list first. - -Returns a list of email addresses (with svcnum entries expanded). - -Note: You can clear the invoicing list by passing an empty ARRAYREF. You can -check it without disturbing anything by passing nothing. - -This interface may change in the future. +sub credit { + my( $self, $amount, $reason, %options ) = @_; -=cut + my $cust_credit = new FS::cust_credit { + 'custnum' => $self->custnum, + 'amount' => $amount, + }; -sub invoicing_list { - my( $self, $arrayref ) = @_; + if ( ref($reason) ) { - if ( $arrayref ) { - my @cust_main_invoice; - if ( $self->custnum ) { - @cust_main_invoice = - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); - } else { - @cust_main_invoice = (); - } - foreach my $cust_main_invoice ( @cust_main_invoice ) { - #warn $cust_main_invoice->destnum; - unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) { - #warn $cust_main_invoice->destnum; - my $error = $cust_main_invoice->delete; - warn $error if $error; - } - } - if ( $self->custnum ) { - @cust_main_invoice = - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + if ( ref($reason) eq 'SCALAR' ) { + $cust_credit->reasonnum( $$reason ); } else { - @cust_main_invoice = (); - } - my %seen = map { $_->address => 1 } @cust_main_invoice; - foreach my $address ( @{$arrayref} ) { - next if exists $seen{$address} && $seen{$address}; - $seen{$address} = 1; - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $cust_main_invoice->insert; - warn $error if $error; + $cust_credit->reasonnum( $reason->reasonnum ); } - } - - if ( $self->custnum ) { - map { $_->address } - qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); + } else { - (); + $cust_credit->set('reason', $reason) } -} - -=item check_invoicing_list ARRAYREF - -Checks these arguements as valid input for the invoicing_list method. If there -is an error, returns the error, otherwise returns false. - -=cut - -sub check_invoicing_list { - my( $self, $arrayref ) = @_; - - foreach my $address ( @$arrayref ) { - - if ($address eq 'FAX' and $self->getfield('fax') eq '') { - return 'Can\'t add FAX invoice destination with a blank FAX number.'; - } - - my $cust_main_invoice = new FS::cust_main_invoice ( { - 'custnum' => $self->custnum, - 'dest' => $address, - } ); - my $error = $self->custnum - ? $cust_main_invoice->check - : $cust_main_invoice->checkdest - ; - return $error if $error; - + for (qw( addlinfo eventnum )) { + $cust_credit->$_( delete $options{$_} ) + if exists($options{$_}); } - return "Email address required" - if $conf->exists('cust_main-require_invoicing_list_email') - && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref; - - ''; -} - -=item set_default_invoicing_list - -Sets the invoicing list to all accounts associated with this customer, -overwriting any previous invoicing list. - -=cut - -sub set_default_invoicing_list { - my $self = shift; - $self->invoicing_list($self->all_emails); -} - -=item all_emails - -Returns the email addresses of all accounts provisioned for this customer. - -=cut - -sub all_emails { - my $self = shift; - my %list; - foreach my $cust_pkg ( $self->all_pkgs ) { - my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); - my @svc_acct = - map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } - grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } - @cust_svc; - $list{$_}=1 foreach map { $_->email } @svc_acct; - } - keys %list; -} - -=item invoicing_list_addpost - -Adds postal invoicing to this customer. If this customer is already configured -to receive postal invoices, does nothing. - -=cut - -sub invoicing_list_addpost { - my $self = shift; - return if grep { $_ eq 'POST' } $self->invoicing_list; - my @invoicing_list = $self->invoicing_list; - push @invoicing_list, 'POST'; - $self->invoicing_list(\@invoicing_list); -} - -=item invoicing_list_emailonly - -Returns the list of email invoice recipients (invoicing_list without non-email -destinations such as POST and FAX). - -=cut - -sub invoicing_list_emailonly { - my $self = shift; - warn "$me invoicing_list_emailonly called" - if $DEBUG; - grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; -} - -=item invoicing_list_emailonly_scalar - -Returns the list of email invoice recipients (invoicing_list without non-email -destinations such as POST and FAX) as a comma-separated scalar. - -=cut - -sub invoicing_list_emailonly_scalar { - my $self = shift; - warn "$me invoicing_list_emailonly_scalar called" - if $DEBUG; - join(', ', $self->invoicing_list_emailonly); -} - -=item referral_custnum_cust_main - -Returns the customer who referred this customer (or the empty string, if -this customer was not referred). - -Note the difference with referral_cust_main method: This method, -referral_custnum_cust_main returns the single customer (if any) who referred -this customer, while referral_cust_main returns an array of customers referred -BY this customer. - -=cut - -sub referral_custnum_cust_main { - my $self = shift; - return '' unless $self->referral_custnum; - qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); -} - -=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] - -Returns an array of customers referred by this customer (referral_custnum set -to this custnum). If DEPTH is given, recurses up to the given depth, returning -customers referred by customers referred by this customer and so on, inclusive. -The default behavior is DEPTH 1 (no recursion). - -Note the difference with referral_custnum_cust_main method: This method, -referral_cust_main, returns an array of customers referred BY this customer, -while referral_custnum_cust_main returns the single customer (if any) who -referred this customer. - -=cut - -sub referral_cust_main { - my $self = shift; - my $depth = @_ ? shift : 1; - my $exclude = @_ ? shift : {}; - - my @cust_main = - map { $exclude->{$_->custnum}++; $_; } - grep { ! $exclude->{ $_->custnum } } - qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } ); - - if ( $depth > 1 ) { - push @cust_main, - map { $_->referral_cust_main($depth-1, $exclude) } - @cust_main; - } - - @cust_main; -} - -=item referral_cust_main_ncancelled - -Same as referral_cust_main, except only returns customers with uncancelled -packages. - -=cut - -sub referral_cust_main_ncancelled { - my $self = shift; - grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main; -} - -=item referral_cust_pkg [ DEPTH ] - -Like referral_cust_main, except returns a flat list of all unsuspended (and -uncancelled) packages for each customer. The number of items in this list may -be useful for commission calculations (perhaps after a Cpkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ). - -=cut - -sub referral_cust_pkg { - my $self = shift; - my $depth = @_ ? shift : 1; - - map { $_->unsuspended_pkgs } - grep { $_->unsuspended_pkgs } - $self->referral_cust_main($depth); -} - -=item referring_cust_main - -Returns the single cust_main record for the customer who referred this customer -(referral_custnum), or false. - -=cut - -sub referring_cust_main { - my $self = shift; - return '' unless $self->referral_custnum; - qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); -} - -=item credit AMOUNT, REASON [ , OPTION => VALUE ... ] - -Applies a credit to this customer. If there is an error, returns the error, -otherwise returns false. - -REASON can be a text string, an FS::reason object, or a scalar reference to -a reasonnum. If a text string, it will be automatically inserted as a new -reason, and a 'reason_type' option must be passed to indicate the -FS::reason_type for the new reason. - -An I option may be passed to set the credit's I field. - -Any other options are passed to FS::cust_credit::insert. - -=cut - -sub credit { - my( $self, $amount, $reason, %options ) = @_; - - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - }; - - if ( ref($reason) ) { - - if ( ref($reason) eq 'SCALAR' ) { - $cust_credit->reasonnum( $$reason ); - } else { - $cust_credit->reasonnum( $reason->reasonnum ); - } - - } else { - $cust_credit->set('reason', $reason) - } - - for (qw( addlinfo eventnum )) { - $cust_credit->$_( delete $options{$_} ) - if exists($options{$_}); - } - - $cust_credit->insert(%options); - -} - -=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] - -Creates a one-time charge for this customer. If there is an error, returns -the error, otherwise returns false. - -New-style, with a hashref of options: - - my $error = $cust_main->charge( - { - 'amount' => 54.32, - 'quantity' => 1, - 'start_date' => str2time('7/4/2009'), - 'pkg' => 'Description', - 'comment' => 'Comment', - 'additional' => [], #extra invoice detail - 'classnum' => 1, #pkg_class - - 'setuptax' => '', # or 'Y' for tax exempt - - #internal taxation - 'taxclass' => 'Tax class', - - #vendor taxation - 'taxproduct' => 2, #part_pkg_taxproduct - 'override' => {}, #XXX describe - - #will be filled in with the new object - 'cust_pkg_ref' => \$cust_pkg, - - #generate an invoice immediately - 'bill_now' => 0, - 'invoice_terms' => '', #with these terms - } - ); - -Old-style: - - my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' ); - -=cut - -sub charge { - my $self = shift; - my ( $amount, $quantity, $start_date, $classnum ); - my ( $pkg, $comment, $additional ); - my ( $setuptax, $taxclass ); #internal taxes - my ( $taxproduct, $override ); #vendor (CCH) taxes - my $no_auto = ''; - my $cust_pkg_ref = ''; - my ( $bill_now, $invoice_terms ) = ( 0, '' ); - if ( ref( $_[0] ) ) { - $amount = $_[0]->{amount}; - $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; - $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : ''; - $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : ''; - $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge'; - $comment = exists($_[0]->{comment}) ? $_[0]->{comment} - : '$'. sprintf("%.2f",$amount); - $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : ''; - $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : ''; - $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : ''; - $additional = $_[0]->{additional} || []; - $taxproduct = $_[0]->{taxproductnum}; - $override = { '' => $_[0]->{tax_override} }; - $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : ''; - $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : ''; - $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; - } else { - $amount = shift; - $quantity = 1; - $start_date = ''; - $pkg = @_ ? shift : 'One-time charge'; - $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); - $setuptax = ''; - $taxclass = @_ ? shift : ''; - $additional = []; - } - - 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 $part_pkg = new FS::part_pkg ( { - 'pkg' => $pkg, - 'comment' => $comment, - 'plan' => 'flat', - 'freq' => 0, - 'disabled' => 'Y', - 'classnum' => ( $classnum ? $classnum : '' ), - 'setuptax' => $setuptax, - 'taxclass' => $taxclass, - 'taxproductnum' => $taxproduct, - } ); - - my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) } - ( 0 .. @$additional - 1 ) - ), - 'additional_count' => scalar(@$additional), - 'setup_fee' => $amount, - ); - - my $error = $part_pkg->insert( options => \%options, - tax_overrides => $override, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my $pkgpart = $part_pkg->pkgpart; - my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart ); - unless ( qsearchs('type_pkgs', \%type_pkgs ) ) { - my $type_pkgs = new FS::type_pkgs \%type_pkgs; - $error = $type_pkgs->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, - 'quantity' => $quantity, - 'start_date' => $start_date, - 'no_auto' => $no_auto, - } ); - - $error = $cust_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } elsif ( $cust_pkg_ref ) { - ${$cust_pkg_ref} = $cust_pkg; - } - - if ( $bill_now ) { - my $error = $self->bill( 'invoice_terms' => $invoice_terms, - 'pkg_list' => [ $cust_pkg ], - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return ''; - -} - -#=item charge_postal_fee -# -#Applies a one time charge this customer. If there is an error, -#returns the error, returns the cust_pkg charge object or false -#if there was no charge. -# -#=cut -# -# This should be a customer event. For that to work requires that bill -# also be a customer event. - -sub charge_postal_fee { - my $self = shift; - - my $pkgpart = $conf->config('postal_invoice-fee_pkgpart'); - return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list); - - my $cust_pkg = new FS::cust_pkg ( { - 'custnum' => $self->custnum, - 'pkgpart' => $pkgpart, - 'quantity' => 1, - } ); - - my $error = $cust_pkg->insert; - $error ? $error : $cust_pkg; -} - -=item cust_bill - -Returns all the invoices (see L) for this customer. - -=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, } ) -} - -=item open_cust_bill - -Returns all the open (owed > 0) invoices (see L) for this -customer. - -=cut - -sub open_cust_bill { - my $self = shift; - - qsearch({ - 'table' => 'cust_bill', - 'hashref' => { 'custnum' => $self->custnum, }, - 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0', - 'order_by' => 'ORDER BY _date ASC', - }); - -} - -=item cust_statements - -Returns all the statements (see L) for this customer. - -=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, } ) -} - -=item cust_credit - -Returns all the credits (see L) for this customer. - -=cut - -sub cust_credit { - my $self = shift; - map { $_ } #return $self->num_cust_credit unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) -} - -=item cust_credit_pkgnum - -Returns all the credits (see L) for this customer's specific -package when using experimental package balances. - -=cut - -sub cust_credit_pkgnum { - my( $self, $pkgnum ) = @_; - map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_credit', { 'custnum' => $self->custnum, - 'pkgnum' => $pkgnum, - } - ); -} - -=item cust_pay - -Returns all the payments (see L) for this customer. - -=cut - -sub cust_pay { - my $self = shift; - return $self->num_cust_pay unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) -} - -=item num_cust_pay - -Returns the number of payments (see L) for this customer. Also -called automatically when the cust_pay method is used in a scalar context. - -=cut - -sub num_cust_pay { - my $self = shift; - my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?"; - my $sth = dbh->prepare($sql) or die dbh->errstr; - $sth->execute($self->custnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; -} - -=item cust_pay_pkgnum - -Returns all the payments (see L) for this customer's specific -package when using experimental package balances. - -=cut - -sub cust_pay_pkgnum { - my( $self, $pkgnum ) = @_; - map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay', { 'custnum' => $self->custnum, - 'pkgnum' => $pkgnum, - } - ); -} - -=item cust_pay_void - -Returns all voided payments (see L) for this customer. - -=cut - -sub cust_pay_void { - my $self = shift; - map { $_ } #return $self->num_cust_pay_void unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) -} - -=item cust_pay_batch - -Returns all batched payments (see L) for this customer. - -=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 } ) -} - -=item cust_pay_pending - -Returns all pending payments (see L) for this customer -(without status "done"). - -=cut - -sub cust_pay_pending { - my $self = shift; - return $self->num_cust_pay_pending unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_pending', { - 'custnum' => $self->custnum, - 'status' => { op=>'!=', value=>'done' }, - }, - ); -} - -=item cust_pay_pending_attempt - -Returns all payment attempts / declined payments for this customer, as pending -payments objects (see L), with status "done" but without -a corresponding payment (see L). - -=cut - -sub cust_pay_pending_attempt { - my $self = shift; - return $self->num_cust_pay_pending_attempt unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_pay_pending', { - 'custnum' => $self->custnum, - 'status' => 'done', - 'paynum' => '', - }, - ); -} - -=item num_cust_pay_pending - -Returns the number of pending payments (see L) for this -customer (without status "done"). Also called automatically when the -cust_pay_pending method is used in a scalar context. - -=cut - -sub num_cust_pay_pending { - my $self = shift; - $self->scalar_sql( - " SELECT COUNT(*) FROM cust_pay_pending ". - " WHERE custnum = ? AND status != 'done' ", - $self->custnum - ); -} - -=item num_cust_pay_pending_attempt - -Returns the number of pending payments (see L) for this -customer, with status "done" but without a corresp. Also called automatically when the -cust_pay_pending method is used in a scalar context. - -=cut - -sub num_cust_pay_pending_attempt { - my $self = shift; - $self->scalar_sql( - " SELECT COUNT(*) FROM cust_pay_pending ". - " WHERE custnum = ? AND status = 'done' AND paynum IS NULL", - $self->custnum - ); -} - -=item cust_refund - -Returns all the refunds (see L) for this customer. - -=cut - -sub cust_refund { - my $self = shift; - map { $_ } #return $self->num_cust_refund unless wantarray; - sort { $a->_date <=> $b->_date } - qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) -} - -=item display_custnum - -Returns the displayed customer number for this customer: agent_custid if -cust_main-default_agent_custid is set and it has a value, custnum otherwise. - -=cut - -sub display_custnum { - my $self = shift; - if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ - return $self->agent_custid; - } else { - return $self->custnum; - } -} - -=item name - -Returns a name string for this customer, either "Company (Last, First)" or -"Last, First". - -=cut - -sub name { - my $self = shift; - my $name = $self->contact; - $name = $self->company. " ($name)" if $self->company; - $name; -} - -=item ship_name - -Returns a name string for this (service/shipping) contact, either -"Company (Last, First)" or "Last, First". - -=cut - -sub ship_name { - my $self = shift; - if ( $self->get('ship_last') ) { - my $name = $self->ship_contact; - $name = $self->ship_company. " ($name)" if $self->ship_company; - $name; - } else { - $self->name; - } -} - -=item name_short - -Returns a name string for this customer, either "Company" or "First Last". - -=cut - -sub name_short { - my $self = shift; - $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast; -} - -=item ship_name_short - -Returns a name string for this (service/shipping) contact, either "Company" -or "First Last". - -=cut - -sub ship_name_short { - my $self = shift; - if ( $self->get('ship_last') ) { - $self->ship_company !~ /^\s*$/ - ? $self->ship_company - : $self->ship_contact_firstlast; - } else { - $self->name_company_or_firstlast; - } -} - -=item contact - -Returns this customer's full (billing) contact name only, "Last, First" - -=cut - -sub contact { - my $self = shift; - $self->get('last'). ', '. $self->first; -} - -=item ship_contact - -Returns this customer's full (shipping) contact name only, "Last, First" - -=cut - -sub ship_contact { - my $self = shift; - $self->get('ship_last') - ? $self->get('ship_last'). ', '. $self->ship_first - : $self->contact; -} - -=item contact_firstlast - -Returns this customers full (billing) contact name only, "First Last". - -=cut - -sub contact_firstlast { - my $self = shift; - $self->first. ' '. $self->get('last'); -} - -=item ship_contact_firstlast - -Returns this customer's full (shipping) contact name only, "First Last". - -=cut - -sub ship_contact_firstlast { - my $self = shift; - $self->get('ship_last') - ? $self->first. ' '. $self->get('ship_last') - : $self->contact_firstlast; -} - -=item country_full - -Returns this customer's full country name - -=cut - -sub country_full { - my $self = shift; - code2country($self->country); -} - -=item geocode DATA_VENDOR - -Returns a value for the customer location as encoded by DATA_VENDOR. -Currently this only makes sense for "CCH" as DATA_VENDOR. - -=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 - -Returns a status string for this customer, currently: - -=over 4 - -=item prospect - No packages have ever been ordered - -=item ordered - Recurring packages all are new (not yet billed). - -=item active - One or more recurring packages is active - -=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) - -=item suspended - All non-cancelled recurring packages are suspended - -=item cancelled - All recurring packages are cancelled - -=back - -=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; - my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; - $sth->execute( ($self->custnum) x $numnum ) - or die "Error executing 'SELECT $sql': ". $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; - } -} - -=item ucfirst_cust_status - -=item ucfirst_status - -Returns the status with the first character capitalized. - -=cut - -sub ucfirst_status { shift->ucfirst_cust_status(@_); } - -sub ucfirst_cust_status { - my $self = shift; - ucfirst($self->cust_status); -} - -=item statuscolor - -Returns a hex triplet color string for this customer's status. - -=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}; -} - -=item tickets - -Returns an array of hashes representing the customer's RT tickets. - -=cut - -sub tickets { - my $self = shift; - - my $num = $conf->config('cust_main-max_tickets') || 10; - my @tickets = (); - - if ( $conf->config('ticket_system') ) { - unless ( $conf->config('ticket_system-custom_priority_field') ) { - - @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) }; - - } else { - - foreach my $priority ( - $conf->config('ticket_system-custom_priority_field-values'), '' - ) { - last if scalar(@tickets) >= $num; - push @tickets, - @{ FS::TicketSystem->customer_tickets( $self->custnum, - $num - scalar(@tickets), - $priority, - ) - }; - } - } - } - (@tickets); -} - -# Return services representing svc_accts in customer support packages -sub support_services { - my $self = shift; - my %packages = map { $_ => 1 } $conf->config('support_packages'); - - grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' } - grep { $_->part_svc->svcdb eq 'svc_acct' } - map { $_->cust_svc } - grep { exists $packages{ $_->pkgpart } } - $self->ncancelled_pkgs; - -} - -# Return a list of latitude/longitude for one of the services (if any) -sub service_coordinates { - my $self = shift; - - my @svc_X = - grep { $_->latitude && $_->longitude } - map { $_->svc_x } - map { $_->cust_svc } - $self->ncancelled_pkgs; - - scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : () + $cust_credit->insert(%options); + } -=back +=item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] -=head1 CLASS METHODS +Creates a one-time charge for this customer. If there is an error, returns +the error, otherwise returns false. -=over 4 +New-style, with a hashref of options: -=item statuses + my $error = $cust_main->charge( + { + 'amount' => 54.32, + 'quantity' => 1, + 'start_date' => str2time('7/4/2009'), + 'pkg' => 'Description', + 'comment' => 'Comment', + 'additional' => [], #extra invoice detail + 'classnum' => 1, #pkg_class -Class method that returns the list of possible status strings for customers -(see L). For example: + 'setuptax' => '', # or 'Y' for tax exempt - @statuses = FS::cust_main->statuses(); + #internal taxation + 'taxclass' => 'Tax class', -=cut + #vendor taxation + 'taxproduct' => 2, #part_pkg_taxproduct + 'override' => {}, #XXX describe -sub statuses { - #my $self = shift; #could be class... - keys %statuscolor; -} + #will be filled in with the new object + 'cust_pkg_ref' => \$cust_pkg, -=item prospect_sql + #generate an invoice immediately + 'bill_now' => 0, + 'invoice_terms' => '', #with these terms + } + ); -Returns an SQL expression identifying prospective cust_main records (customers -with no packages ever ordered) +Old-style: + + my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' ); =cut -use vars qw($select_count_pkgs); -$select_count_pkgs = - "SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum"; +sub charge { + my $self = shift; + my ( $amount, $quantity, $start_date, $classnum ); + my ( $pkg, $comment, $additional ); + my ( $setuptax, $taxclass ); #internal taxes + my ( $taxproduct, $override ); #vendor (CCH) taxes + my $no_auto = ''; + my $cust_pkg_ref = ''; + my ( $bill_now, $invoice_terms ) = ( 0, '' ); + if ( ref( $_[0] ) ) { + $amount = $_[0]->{amount}; + $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1; + $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : ''; + $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : ''; + $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge'; + $comment = exists($_[0]->{comment}) ? $_[0]->{comment} + : '$'. sprintf("%.2f",$amount); + $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : ''; + $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : ''; + $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : ''; + $additional = $_[0]->{additional} || []; + $taxproduct = $_[0]->{taxproductnum}; + $override = { '' => $_[0]->{tax_override} }; + $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : ''; + $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : ''; + $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : ''; + } else { + $amount = shift; + $quantity = 1; + $start_date = ''; + $pkg = @_ ? shift : 'One-time charge'; + $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + $setuptax = ''; + $taxclass = @_ ? shift : ''; + $additional = []; + } -sub select_count_pkgs_sql { - $select_count_pkgs; -} + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; -sub prospect_sql { - " 0 = ( $select_count_pkgs ) "; -} + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; -=item ordered_sql + my $part_pkg = new FS::part_pkg ( { + 'pkg' => $pkg, + 'comment' => $comment, + 'plan' => 'flat', + 'freq' => 0, + 'disabled' => 'Y', + 'classnum' => ( $classnum ? $classnum : '' ), + 'setuptax' => $setuptax, + 'taxclass' => $taxclass, + 'taxproductnum' => $taxproduct, + } ); -Returns an SQL expression identifying ordered cust_main records (customers with -recurring packages not yet setup). + my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) } + ( 0 .. @$additional - 1 ) + ), + 'additional_count' => scalar(@$additional), + 'setup_fee' => $amount, + ); -=cut + my $error = $part_pkg->insert( options => \%options, + tax_overrides => $override, + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } -sub ordered_sql { - FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; -} + my $pkgpart = $part_pkg->pkgpart; + my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart ); + unless ( qsearchs('type_pkgs', \%type_pkgs ) ) { + my $type_pkgs = new FS::type_pkgs \%type_pkgs; + $error = $type_pkgs->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } -=item active_sql + my $cust_pkg = new FS::cust_pkg ( { + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => $quantity, + 'start_date' => $start_date, + 'no_auto' => $no_auto, + } ); -Returns an SQL expression identifying active cust_main records (customers with -active recurring packages). + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } elsif ( $cust_pkg_ref ) { + ${$cust_pkg_ref} = $cust_pkg; + } -=cut + if ( $bill_now ) { + my $error = $self->bill( 'invoice_terms' => $invoice_terms, + 'pkg_list' => [ $cust_pkg ], + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; -sub active_sql { - " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } -=item none_active_sql +#=item charge_postal_fee +# +#Applies a one time charge this customer. If there is an error, +#returns the error, returns the cust_pkg charge object or false +#if there was no charge. +# +#=cut +# +# This should be a customer event. For that to work requires that bill +# also be a customer event. -Returns an SQL expression identifying cust_main records with no active -recurring packages. This includes customers of status prospect, ordered, -inactive, and suspended. +sub charge_postal_fee { + my $self = shift; -=cut + my $pkgpart = $conf->config('postal_invoice-fee_pkgpart'); + return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list); -sub none_active_sql { - " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; + my $cust_pkg = new FS::cust_pkg ( { + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, + 'quantity' => 1, + } ); + + my $error = $cust_pkg->insert; + $error ? $error : $cust_pkg; } -=item inactive_sql +=item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] -Returns an SQL expression identifying inactive cust_main records (customers with -no active recurring packages, but otherwise unsuspended/uncancelled). +Returns all the invoices (see L) for this customer. + +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. =cut -sub inactive_sql { - FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; +sub cust_bill { + my $self = shift; + 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 susp_sql -=item suspended_sql +=item open_cust_bill -Returns an SQL expression identifying suspended cust_main records. +Returns all the open (owed > 0) invoices (see L) for this +customer. =cut +sub open_cust_bill { + my $self = shift; -sub suspended_sql { susp_sql(@_); } -sub susp_sql { - FS::cust_main->none_active_sql. - " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; -} + $self->cust_bill( + 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0', + #@_ + ); -=item cancel_sql -=item cancelled_sql +} -Returns an SQL expression identifying cancelled cust_main records. +=item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] -=cut +Returns all the statements (see L) for this customer. -sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. - my $recurring_sql = FS::cust_pkg->recurring_sql; - my $cancelled_sql = FS::cust_pkg->cancelled_sql; +=cut - " - 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 cust_statement { + my $self = shift; + 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 uncancel_sql -=item uncancelled_sql +=item cust_credit -Returns an SQL expression identifying un-cancelled cust_main records. +Returns all the credits (see L) for this customer. =cut -sub uncancelled_sql { uncancel_sql(@_); } -sub uncancel_sql { " - ( 0 < ( $select_count_pkgs - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( $select_count_pkgs ) - ) -"; } +sub cust_credit { + my $self = shift; + map { $_ } #return $self->num_cust_credit unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) +} -=item balance_sql +=item cust_credit_pkgnum -Returns an SQL fragment to retreive the balance. +Returns all the credits (see L) for this customer's specific +package when using experimental package balances. =cut -sub balance_sql { " - ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill - WHERE cust_bill.custnum = cust_main.custnum ) - - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay - WHERE cust_pay.custnum = cust_main.custnum ) - - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit - WHERE cust_credit.custnum = cust_main.custnum ) - + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund - WHERE cust_refund.custnum = cust_main.custnum ) -"; } - -=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] - -Returns an SQL fragment to retreive the balance for this customer, optionally -considering invoices with date earlier than START_TIME, and not -later than END_TIME (total_owed_date minus total_unapplied_credits minus -total_unapplied_payments). +sub cust_credit_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_credit', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} -Times are specified as SQL fragments or numeric -UNIX timestamps; see L). Also see L and -L for conversion functions. The empty string can be passed -to disable that time constraint completely. +=item cust_pay -Available options are: +Returns all the payments (see L) for this customer. -=over 4 +=cut -=item unapplied_date +sub cust_pay { + my $self = shift; + return $self->num_cust_pay unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) +} -set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) +=item num_cust_pay -=item total +Returns the number of payments (see L) for this customer. Also +called automatically when the cust_pay method is used in a scalar context. -(unused. obsolete?) -set to true to remove all customer comparison clauses, for totals +=cut -=item where +sub num_cust_pay { + my $self = shift; + my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?"; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute($self->custnum) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} -(unused. obsolete?) -WHERE clause hashref (elements "AND"ed together) (typically used with the total option) +=item cust_pay_pkgnum -=item join +Returns all the payments (see L) for this customer's specific +package when using experimental package balances. -(unused. obsolete?) -JOIN clause (typically used with the total option) +=cut -=item cutoff +sub cust_pay_pkgnum { + my( $self, $pkgnum ) = @_; + map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay', { 'custnum' => $self->custnum, + 'pkgnum' => $pkgnum, + } + ); +} -An absolute cutoff time. Payments, credits, and refunds I after this -time will be ignored. Note that START_TIME and END_TIME only limit the date -range for invoices and I payments, credits, and refunds. +=item cust_pay_void -=back +Returns all voided payments (see L) for this customer. =cut -sub balance_date_sql { - my( $class, $start, $end, %opt ) = @_; +sub cust_pay_void { + my $self = shift; + map { $_ } #return $self->num_cust_pay_void unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } ) +} - my $cutoff = $opt{'cutoff'}; +=item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] - my $owed = FS::cust_bill->owed_sql($cutoff); - my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff); - my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff); - my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); +Returns all batched payments (see L) for this customer. - my $j = $opt{'join'} || ''; +Optionally, a list or hashref of additional arguments to the qsearch call can +be passed. - my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt ); - my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt ); - my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt ); - my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt ); +=cut - " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh ) - + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh ) - - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh ) - - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh ) - "; +sub cust_pay_batch { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; -} + #return $self->num_cust_statement unless wantarray || keys %$opt; -=item unapplied_payments_date_sql START_TIME [ END_TIME ] + $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'; -Returns an SQL fragment to retreive the total unapplied payments for this -customer, only considering invoices with date earlier than START_TIME, and -optionally not later than END_TIME. + map { $_ } #behavior of sort undefined in scalar context + sort { $a->paybatchnum <=> $b->paybatchnum } + qsearch($opt); +} -Times are specified as SQL fragments or numeric -UNIX timestamps; see L). Also see L and -L for conversion functions. The empty string can be passed -to disable that time constraint completely. +=item cust_pay_pending -Available options are: +Returns all pending payments (see L) for this customer +(without status "done"). =cut -sub unapplied_payments_date_sql { - my( $class, $start, $end, %opt ) = @_; +sub cust_pay_pending { + my $self = shift; + return $self->num_cust_pay_pending unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' }, + }, + ); +} - my $cutoff = $opt{'cutoff'}; +=item cust_pay_pending_attempt - my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); +Returns all payment attempts / declined payments for this customer, as pending +payments objects (see L), with status "done" but without +a corresponding payment (see L). - my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, - 'unapplied_date'=>1 ); +=cut - " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; +sub cust_pay_pending_attempt { + my $self = shift; + return $self->num_cust_pay_pending_attempt unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => 'done', + 'paynum' => '', + }, + ); } -=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] - -Helper method for balance_date_sql; name (and usage) subject to change -(suggestions welcome). - -Returns a WHERE clause for the specified monetary TABLE (cust_bill, -cust_refund, cust_credit or cust_pay). +=item num_cust_pay_pending -If TABLE is "cust_bill" or the unapplied_date option is true, only -considers records with date earlier than START_TIME, and optionally not -later than END_TIME . +Returns the number of pending payments (see L) for this +customer (without status "done"). Also called automatically when the +cust_pay_pending method is used in a scalar context. =cut -sub _money_table_where { - my( $class, $table, $start, $end, %opt ) = @_; - - my @where = (); - push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'}; - if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) { - push @where, "$table._date <= $start" if defined($start) && length($start); - push @where, "$table._date > $end" if defined($end) && length($end); - } - push @where, @{$opt{'where'}} if $opt{'where'}; - my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : ''; +sub num_cust_pay_pending { + my $self = shift; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status != 'done' ", + $self->custnum + ); +} - $where; +=item num_cust_pay_pending_attempt -} +Returns the number of pending payments (see L) for this +customer, with status "done" but without a corresp. Also called automatically when the +cust_pay_pending method is used in a scalar context. -=item search HASHREF +=cut -(Class method) +sub num_cust_pay_pending_attempt { + my $self = shift; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_pay_pending ". + " WHERE custnum = ? AND status = 'done' AND paynum IS NULL", + $self->custnum + ); +} -Returns a qsearch hash expression to search for parameters specified in -HASHREF. Valid parameters are +=item cust_refund -=over 4 +Returns all the refunds (see L) for this customer. -=item agentnum +=cut -=item status +sub cust_refund { + my $self = shift; + map { $_ } #return $self->num_cust_refund unless wantarray; + sort { $a->_date <=> $b->_date } + qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) +} -=item cancelled_pkgs +=item display_custnum -bool +Returns the displayed customer number for this customer: agent_custid if +cust_main-default_agent_custid is set and it has a value, custnum otherwise. -=item signupdate +=cut -listref of start date, end date +sub display_custnum { + my $self = shift; + if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ + return $self->agent_custid; + } else { + return $self->custnum; + } +} -=item payby +=item name -listref +Returns a name string for this customer, either "Company (Last, First)" or +"Last, First". -=item paydate_year +=cut -=item paydate_month +sub name { + my $self = shift; + my $name = $self->contact; + $name = $self->company. " ($name)" if $self->company; + $name; +} -=item current_balance +=item ship_name -listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance')) +Returns a name string for this (service/shipping) contact, either +"Company (Last, First)" or "Last, First". -=item cust_fields +=cut -=item flattened_pkgs +sub ship_name { + my $self = shift; + if ( $self->get('ship_last') ) { + my $name = $self->ship_contact; + $name = $self->ship_company. " ($name)" if $self->ship_company; + $name; + } else { + $self->name; + } +} -bool +=item name_short -=back +Returns a name string for this customer, either "Company" or "First Last". =cut -sub search { - my ($class, $params) = @_; +sub name_short { + my $self = shift; + $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast; +} - my $dbh = dbh; +=item ship_name_short - my @where = (); - my $orderby; +Returns a name string for this (service/shipping) contact, either "Company" +or "First Last". - ## - # parse agent - ## +=cut - if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { - push @where, - "cust_main.agentnum = $1"; +sub ship_name_short { + my $self = shift; + if ( $self->get('ship_last') ) { + $self->ship_company !~ /^\s*$/ + ? $self->ship_company + : $self->ship_contact_firstlast; + } else { + $self->name_company_or_firstlast; } +} - ## - # do the same for user - ## - - if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) { - push @where, - "cust_main.usernum = $1"; - } +=item contact - ## - # parse status - ## +Returns this customer's full (billing) contact name only, "Last, First" - #prospect ordered active inactive suspended cancelled - if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) { - my $method = $params->{'status'}. '_sql'; - #push @where, $class->$method(); - push @where, FS::cust_main->$method(); - } - - ## - # parse cancelled package checkbox - ## +=cut - my $pkgwhere = ""; +sub contact { + my $self = shift; + $self->get('last'). ', '. $self->first; +} - $pkgwhere .= "AND (cancel = 0 or cancel is null)" - unless $params->{'cancelled_pkgs'}; +=item ship_contact - ## - # parse without census tract checkbox - ## +Returns this customer's full (shipping) contact name only, "Last, First" - push @where, "(censustract = '' or censustract is null)" - if $params->{'no_censustract'}; +=cut - ## - # dates - ## +sub ship_contact { + my $self = shift; + $self->get('ship_last') + ? $self->get('ship_last'). ', '. $self->ship_first + : $self->contact; +} - foreach my $field (qw( signupdate )) { +=item contact_firstlast - next unless exists($params->{$field}); +Returns this customers full (billing) contact name only, "First Last". - my($beginning, $ending, $hour) = @{$params->{$field}}; +=cut - push @where, - "cust_main.$field IS NOT NULL", - "cust_main.$field >= $beginning", - "cust_main.$field <= $ending"; +sub contact_firstlast { + my $self = shift; + $self->first. ' '. $self->get('last'); +} - # XXX: do this for mysql and/or pull it out of here - if(defined $hour) { - if ($dbh->{Driver}->{Name} eq 'Pg') { - push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour"; - } - else { - warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases"; - } - } +=item ship_contact_firstlast - $orderby ||= "ORDER BY cust_main.$field"; +Returns this customer's full (shipping) contact name only, "First Last". - } +=cut - ### - # classnum - ### +sub ship_contact_firstlast { + my $self = shift; + $self->get('ship_last') + ? $self->first. ' '. $self->get('ship_last') + : $self->contact_firstlast; +} - if ( $params->{'classnum'} ) { +=item country_full - my @classnum = ref( $params->{'classnum'} ) - ? @{ $params->{'classnum'} } - : ( $params->{'classnum'} ); +Returns this customer's full country name - @classnum = grep /^(\d*)$/, @classnum; +=cut - if ( @classnum ) { - push @where, '( '. join(' OR ', map { - $_ ? "cust_main.classnum = $_" - : "cust_main.classnum IS NULL" - } - @classnum - ). - ' )'; - } +sub country_full { + my $self = shift; + code2country($self->country); +} - } +=item geocode DATA_VENDOR - ### - # payby - ### +Returns a value for the customer location as encoded by DATA_VENDOR. +Currently this only makes sense for "CCH" as DATA_VENDOR. - if ( $params->{'payby'} ) { +=cut - my @payby = ref( $params->{'payby'} ) - ? @{ $params->{'payby'} } - : ( $params->{'payby'} ); +sub geocode { + my ($self, $data_vendor) = (shift, shift); #always cch for now - @payby = grep /^([A-Z]{4})$/, @payby; + my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode + return $geocode if $geocode; - push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )' - if @payby; + 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'; - ### - # paydate_year / paydate_month - ### + $zip ||= ''; + $plus4 ||= ''; + #CCH specific location stuff + my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'"; - if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) { - my $year = $1; - $params->{'paydate_month'} =~ /^(\d\d?)$/ - or die "paydate_year without paydate_month?"; - my $month = $1; + 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); - push @where, - 'paydate IS NOT NULL', - "paydate != ''", - "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )" -; - } + $geocode; +} - ### - # invoice terms - ### +=item cust_status - if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) { - my $terms = $1; - if ( $1 eq 'NULL' ) { - push @where, - "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )"; - } else { - push @where, - "cust_main.invoice_terms IS NOT NULL", - "cust_main.invoice_terms = '$1'"; - } - } +=item status - ## - # amounts - ## +Returns a status string for this customer, currently: - if ( $params->{'current_balance'} ) { +=over 4 - #my $balance_sql = $class->balance_sql(); - my $balance_sql = FS::cust_main->balance_sql(); +=item prospect - No packages have ever been ordered - my @current_balance = - ref( $params->{'current_balance'} ) - ? @{ $params->{'current_balance'} } - : ( $params->{'current_balance'} ); +=item ordered - Recurring packages all are new (not yet billed). - push @where, map { s/current_balance/$balance_sql/; $_ } - @current_balance; +=item active - One or more recurring packages is active - } +=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) - ## - # custbatch - ## +=item suspended - All non-cancelled recurring packages are suspended - if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { - push @where, - "cust_main.custbatch = '$1'"; - } +=item cancelled - All recurring packages are cancelled - ## - # setup queries, subs, etc. for the search - ## +=back - $orderby ||= 'ORDER BY custnum'; +=cut - # here is the agent virtualization - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql; +sub status { shift->cust_status(@_); } - my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; +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; + my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; + $sth->execute( ($self->custnum) x $numnum ) + or die "Error executing 'SELECT $sql': ". $sth->errstr; + return $status if $sth->fetchrow_arrayref->[0]; + } +} - my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) '; +=item ucfirst_cust_status - my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql"; +=item ucfirst_status - my $select = join(', ', - 'cust_main.custnum', - FS::UI::Web::cust_sql_fields($params->{'cust_fields'}), - ); +Returns the status with the first character capitalized. - my(@extra_headers) = (); - my(@extra_fields) = (); +=cut - if ($params->{'flattened_pkgs'}) { +sub ucfirst_status { shift->ucfirst_cust_status(@_); } - if ($dbh->{Driver}->{Name} eq 'Pg') { +sub ucfirst_cust_status { + my $self = shift; + ucfirst($self->cust_status); +} - $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic"; +=item statuscolor - }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) { - $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic"; - $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )"; - }else{ - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "omitting packing information from report."; - } +Returns a hex triplet color string for this customer's status. - my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1"; - - my $sth = dbh->prepare($header_query) or die dbh->errstr; - $sth->execute() or die $sth->errstr; - my $headerrow = $sth->fetchrow_arrayref; - my $headercount = $headerrow ? $headerrow->[0] : 0; - while($headercount) { - unshift @extra_headers, "Package ". $headercount; - unshift @extra_fields, eval q!sub {my $c = shift; - my @a = split '\|', $c->magic; - my $p = $a[!.--$headercount. q!]; - $p; - };!; - } +=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 +; - my $sql_query = { - 'table' => 'cust_main', - 'select' => $select, - 'hashref' => {}, - 'extra_sql' => $extra_sql, - 'order_by' => $orderby, - 'count_query' => $count_query, - 'extra_headers' => \@extra_headers, - 'extra_fields' => \@extra_fields, - }; +sub statuscolor { shift->cust_statuscolor(@_); } +sub cust_statuscolor { + my $self = shift; + $statuscolor{$self->cust_status}; } -=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] - -Performs a fuzzy (approximate) search and returns the matching FS::cust_main -records. Currently, I, I, I and/or I may be -specified (the appropriate ship_ field is also searched). +=item tickets -Additional options are the same as FS::Record::qsearch +Returns an array of hashes representing the customer's RT tickets. =cut -sub fuzzy_search { - my( $self, $fuzzy, $hash, @opt) = @_; - #$self - $hash ||= {}; - my @cust_main = (); +sub tickets { + my $self = shift; + + my $num = $conf->config('cust_main-max_tickets') || 10; + my @tickets = (); - check_and_rebuild_fuzzyfiles(); - foreach my $field ( keys %$fuzzy ) { + if ( $conf->config('ticket_system') ) { + unless ( $conf->config('ticket_system-custom_priority_field') ) { - my $all = $self->all_X($field); - next unless scalar(@$all); + @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) }; - my %match = (); - $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) ); + } else { - my @fcust = (); - foreach ( keys %match ) { - push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); + foreach my $priority ( + $conf->config('ticket_system-custom_priority_field-values'), '' + ) { + last if scalar(@tickets) >= $num; + push @tickets, + @{ FS::TicketSystem->customer_tickets( $self->custnum, + $num - scalar(@tickets), + $priority, + ) + }; + } } - my %fsaw = (); - push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; } + (@tickets); +} - # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes - my %saw = (); - @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main; +# Return services representing svc_accts in customer support packages +sub support_services { + my $self = shift; + my %packages = map { $_ => 1 } $conf->config('support_packages'); - @cust_main; + grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' } + grep { $_->part_svc->svcdb eq 'svc_acct' } + map { $_->cust_svc } + grep { exists $packages{ $_->pkgpart } } + $self->ncancelled_pkgs; + +} + +# Return a list of latitude/longitude for one of the services (if any) +sub service_coordinates { + my $self = shift; + + my @svc_X = + grep { $_->latitude && $_->longitude } + map { $_->svc_x } + map { $_->cust_svc } + $self->ncancelled_pkgs; + scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : () } =item masked FIELD @@ -5349,446 +3797,321 @@ my ($self,$field) = @_; # Show last four -'x'x(length($self->getfield($field))-4). - substr($self->getfield($field), (length($self->getfield($field))-4)); +'x'x(length($self->getfield($field))-4). + substr($self->getfield($field), (length($self->getfield($field))-4)); + +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item statuses + +Class method that returns the list of possible status strings for customers +(see L). For example: + + @statuses = FS::cust_main->statuses(); + +=cut +sub statuses { + #my $self = shift; #could be class... + keys %statuscolor; } -=back +=item prospect_sql -=head1 SUBROUTINES +Returns an SQL expression identifying prospective cust_main records (customers +with no packages ever ordered) -=over 4 +=cut + +use vars qw($select_count_pkgs); +$select_count_pkgs = + "SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum"; -=item smart_search OPTION => VALUE ... +sub select_count_pkgs_sql { + $select_count_pkgs; +} -Accepts the following options: I, the string to search for. The string -will be searched for as a customer number, phone number, name or company name, -as an exact, or, in some cases, a substring or fuzzy match (see the source code -for the exact heuristics used); I, causes smart_search to -skip fuzzy matching when an exact match is found. +sub prospect_sql { + " 0 = ( $select_count_pkgs ) "; +} -Any additional options are treated as an additional qualifier on the search -(i.e. I). +=item ordered_sql -Returns a (possibly empty) array of FS::cust_main objects. +Returns an SQL expression identifying ordered cust_main records (customers with +recurring packages not yet setup). =cut -sub smart_search { - my %options = @_; +sub ordered_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) "; +} - #here is the agent virtualization - my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; +=item active_sql - my @cust_main = (); +Returns an SQL expression identifying active cust_main records (customers with +active recurring packages). - my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'}; - my $search = delete $options{'search'}; - ( my $alphanum_search = $search ) =~ s/\W//g; - - if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search - - #false laziness w/Record::ut_phone - my $phonen = "$1-$2-$3"; - $phonen .= " x$4" if $4; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ = '$phonen'", - qw( daytime night fax - ship_daytime ship_night ship_fax ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); +=cut - unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match - #try looking for matches with extensions unless one was specified - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). - ' ( '. - join(' OR ', map "$_ LIKE '$phonen\%'", - qw( daytime night - ship_daytime ship_night ) - ). - ' ) '. - " AND $agentnums_sql", #agent virtualization - } ); +sub active_sql { + " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; +} - } +=item none_active_sql - # custnum search (also try agent_custid), with some tweaking options if your - # legacy cust "numbers" have letters - } +Returns an SQL expression identifying cust_main records with no active +recurring packages. This includes customers of status prospect, ordered, +inactive, and suspended. - if ( $search =~ /^\s*(\d+)\s*$/ - || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+' - && $search =~ /^\s*(\w\w?\d+)\s*$/ - ) - || ( $conf->exists('address1-search' ) - && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D - ) - ) - { +=cut - my $num = $1; +sub none_active_sql { + " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; +} - if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'custnum' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); - } +=item inactive_sql - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { 'agent_custid' => $num, %options }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualization - } ); +Returns an SQL expression identifying inactive cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). - if ( $conf->exists('address1-search') ) { - my $len = length($num); - $num = lc($num); - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options, }, - 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ". - " AND $agentnums_sql", - } ); - } - } +=cut - } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { - - my($company, $last, $first) = ( $1, $2, $3 ); - - # "Company (Last, First)" - #this is probably something a browser remembered, - #so just do an exact search (but case-insensitive, so USPS standardization - #doesn't throw a wrench in the works) - - foreach my $prefix ( '', 'ship_' ) { - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %options }, - 'extra_sql' => - ( keys(%options) ? ' AND ' : ' WHERE ' ). - join(' AND ', - " LOWER(${prefix}first) = ". dbh->quote(lc($first)), - " LOWER(${prefix}last) = ". dbh->quote(lc($last)), - " LOWER(${prefix}company) = ". dbh->quote(lc($company)), - $agentnums_sql, - ), - } ); - } +sub inactive_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) "; +} - } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search - # try (ship_){last,company} +=item susp_sql +=item suspended_sql - my $value = lc($1); +Returns an SQL expression identifying suspended cust_main records. - # # remove "(Last, First)" in "Company (Last, First)", otherwise the - # # full strings the browser remembers won't work - # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name +=cut - use Lingua::EN::NameParse; - my $NameParse = new Lingua::EN::NameParse( - auto_clean => 1, - allow_reversed => 1, - ); - my($last, $first) = ( '', '' ); - #maybe disable this too and just rely on NameParse? - if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First - - ($last, $first) = ( $1, $2 ); - - #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) { - } elsif ( ! $NameParse->parse($value) ) { +sub suspended_sql { susp_sql(@_); } +sub susp_sql { + FS::cust_main->none_active_sql. + " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) "; +} - my %name = $NameParse->components; - $first = $name{'given_name_1'}; - $last = $name{'surname_1'}; +=item cancel_sql +=item cancelled_sql - } +Returns an SQL expression identifying cancelled cust_main records. - if ( $first && $last ) { +=cut - my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) ); +sub cancelled_sql { cancel_sql(@_); } +sub cancel_sql { - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " - ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first ) - OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first ) - )"; + my $recurring_sql = FS::cust_pkg->recurring_sql; + my $cancelled_sql = FS::cust_pkg->cancelled_sql; - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); + " + 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. " ) + "; - # or it just be something that was typed in... (try that in a sec) +} - } +=item uncancel_sql +=item uncancelled_sql - my $q_value = dbh->quote($value); - - #exact - my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; - $sql .= " ( LOWER(last) = $q_value - OR LOWER(company) = $q_value - OR LOWER(ship_last) = $q_value - OR LOWER(ship_company) = $q_value - "; - $sql .= " OR LOWER(address1) = $q_value - OR LOWER(ship_address1) = $q_value - " - if $conf->exists('address1-search'); - $sql .= " )"; - - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => \%options, - 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization - } ); +Returns an SQL expression identifying un-cancelled cust_main records. - #no exact match, trying substring/fuzzy - #always do substring & fuzzy (unless they're explicity config'ed off) - #getting complaints searches are not returning enough - unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) { +=cut - #still some false laziness w/search (was search/cust_main.cgi) +sub uncancelled_sql { uncancel_sql(@_); } +sub uncancel_sql { " + ( 0 < ( $select_count_pkgs + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( $select_count_pkgs ) + ) +"; } - #substring +=item balance_sql - my @hashrefs = ( - { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, - ); +Returns an SQL fragment to retreive the balance. - if ( $first && $last ) { +=cut - push @hashrefs, - { 'first' => { op=>'ILIKE', value=>"%$first%" }, - 'last' => { op=>'ILIKE', value=>"%$last%" }, - }, - { 'ship_first' => { op=>'ILIKE', value=>"%$first%" }, - 'ship_last' => { op=>'ILIKE', value=>"%$last%" }, - }, - ; +sub balance_sql { " + ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill + WHERE cust_bill.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay + WHERE cust_pay.custnum = cust_main.custnum ) + - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit + WHERE cust_credit.custnum = cust_main.custnum ) + + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund + WHERE cust_refund.custnum = cust_main.custnum ) +"; } - } else { +=item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ] - push @hashrefs, - { 'last' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } +Returns an SQL fragment to retreive the balance for this customer, optionally +considering invoices with date earlier than START_TIME, and not +later than END_TIME (total_owed_date minus total_unapplied_credits minus +total_unapplied_payments). - if ( $conf->exists('address1-search') ) { - push @hashrefs, - { 'address1' => { op=>'ILIKE', value=>"%$value%" }, }, - { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, }, - ; - } +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - foreach my $hashref ( @hashrefs ) { +Available options are: - push @cust_main, qsearch( { - 'table' => 'cust_main', - 'hashref' => { %$hashref, - %options, - }, - 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton - } ); +=over 4 - } +=item unapplied_date - #fuzzy - my @fuzopts = ( - \%options, #hashref - '', #select - " AND $agentnums_sql", #extra_sql #agent virtualization - ); - - if ( $first && $last ) { - push @cust_main, FS::cust_main->fuzzy_search( - { 'last' => $last, #fuzzy hashref - 'first' => $first }, # - @fuzopts - ); - } - foreach my $field ( 'last', 'company' ) { - push @cust_main, - FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); - } - if ( $conf->exists('address1-search') ) { - push @cust_main, - FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts ); - } +set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering) - } +=item total - } +(unused. obsolete?) +set to true to remove all customer comparison clauses, for totals - #eliminate duplicates - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; +=item where - @cust_main; +(unused. obsolete?) +WHERE clause hashref (elements "AND"ed together) (typically used with the total option) -} +=item join -=item email_search +(unused. obsolete?) +JOIN clause (typically used with the total option) -Accepts the following options: I, the email address to search for. The -email address will be searched for as an email invoice destination and as an -svc_acct account. +=item cutoff -#Any additional options are treated as an additional qualifier on the search -#(i.e. I). +An absolute cutoff time. Payments, credits, and refunds I after this +time will be ignored. Note that START_TIME and END_TIME only limit the date +range for invoices and I payments, credits, and refunds. -Returns a (possibly empty) array of FS::cust_main objects (but usually just -none or one). +=back =cut -sub email_search { - my %options = @_; +sub balance_date_sql { + my( $class, $start, $end, %opt ) = @_; - local($DEBUG) = 1; + my $cutoff = $opt{'cutoff'}; - my $email = delete $options{'email'}; + my $owed = FS::cust_bill->owed_sql($cutoff); + my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff); + my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff); + my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); - #we're only being used by RT at the moment... no agent virtualization yet - #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; + my $j = $opt{'join'} || ''; - my @cust_main = (); + my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt ); + my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt ); + my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt ); + my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt ); - if ( $email =~ /([^@]+)\@([^@]+)/ ) { + " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh ) + + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh ) + - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh ) + - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh ) + "; - my ( $user, $domain ) = ( $1, $2 ); +} - warn "$me smart_search: searching for $user in domain $domain" - if $DEBUG; +=item unapplied_payments_date_sql START_TIME [ END_TIME ] - push @cust_main, - map $_->cust_main, - qsearch( { - 'table' => 'cust_main_invoice', - 'hashref' => { 'dest' => $email }, - } - ); +Returns an SQL fragment to retreive the total unapplied payments for this +customer, only considering invoices with date earlier than START_TIME, and +optionally not later than END_TIME. - push @cust_main, - map $_->cust_main, - grep $_, - map $_->cust_svc->cust_pkg, - qsearch( { - 'table' => 'svc_acct', - 'hashref' => { 'username' => $user, }, - 'extra_sql' => - 'AND ( SELECT domain FROM svc_domain - WHERE svc_acct.domsvc = svc_domain.svcnum - ) = '. dbh->quote($domain), - } - ); - } +Times are specified as SQL fragments or numeric +UNIX timestamps; see L). Also see L and +L for conversion functions. The empty string can be passed +to disable that time constraint completely. - my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; +Available options are: - warn "$me smart_search: found ". scalar(@cust_main). " unique customers" - if $DEBUG; +=cut - @cust_main; +sub unapplied_payments_date_sql { + my( $class, $start, $end, %opt ) = @_; -} + my $cutoff = $opt{'cutoff'}; -=item check_and_rebuild_fuzzyfiles + my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff); -=cut + my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end, + 'unapplied_date'=>1 ); -sub check_and_rebuild_fuzzyfiles { - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields + " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) "; } -=item rebuild_fuzzyfiles - -=cut - -sub rebuild_fuzzyfiles { - - use Fcntl qw(:flock); +=item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ] - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - mkdir $dir, 0700 unless -d $dir; +Helper method for balance_date_sql; name (and usage) subject to change +(suggestions welcome). - foreach my $fuzzy ( @fuzzyfields ) { +Returns a WHERE clause for the specified monetary TABLE (cust_bill, +cust_refund, cust_credit or cust_pay). - open(LOCK,">>$dir/cust_main.$fuzzy") - or die "can't open $dir/cust_main.$fuzzy: $!"; - flock(LOCK,LOCK_EX) - or die "can't lock $dir/cust_main.$fuzzy: $!"; +If TABLE is "cust_bill" or the unapplied_date option is true, only +considers records with date earlier than START_TIME, and optionally not +later than END_TIME . - open (CACHE,">$dir/cust_main.$fuzzy.tmp") - or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; +=cut - foreach my $field ( $fuzzy, "ship_$fuzzy" ) { - my $sth = dbh->prepare("SELECT $field FROM cust_main". - " WHERE $field != '' AND $field IS NOT NULL"); - $sth->execute or die $sth->errstr; +sub _money_table_where { + my( $class, $table, $start, $end, %opt ) = @_; - while ( my $row = $sth->fetchrow_arrayref ) { - print CACHE $row->[0]. "\n"; - } + my @where = (); + push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'}; + if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) { + push @where, "$table._date <= $start" if defined($start) && length($start); + push @where, "$table._date > $end" if defined($end) && length($end); + } + push @where, @{$opt{'where'}} if $opt{'where'}; + my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : ''; - } + $where; - close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; - - rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; - close LOCK; - } +} +#for dyanmic FS::$table->search in httemplate/misc/email_customers.html +use FS::cust_main::Search; +sub search { + my $class = shift; + FS::cust_main::Search->search(@_); } -=item all_X +=back -=cut +=head1 SUBROUTINES -sub all_X { - my( $self, $field ) = @_; - my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc; - open(CACHE,"<$dir/cust_main.$field") - or die "can't open $dir/cust_main.$field: $!"; - my @array = map { chomp; $_; } ; - close CACHE; - \@array; -} +=over 4 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1 =cut +use FS::cust_main::Search; sub append_fuzzyfiles { #my( $first, $last, $company ) = @_; - &check_and_rebuild_fuzzyfiles; + FS::cust_main::Search::check_and_rebuild_fuzzyfiles(); use Fcntl qw(:flock); @@ -6286,11 +4609,17 @@ sub process_bill_and_collect { 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; + foreach my $sql ( + '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', + ) { + 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);