X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=b1a4d0303616e2bae12bf1714d1033a22f2144db;hb=140fba9bbf23d8b18ee066229bbabb5286aa9bb4;hp=5271d49f489775850d0bb0dd63c0cf174bdf319a;hpb=df785bf1ef8322a05691d4bda9549a2bda79a5d4;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 5271d49f4..b1a4d0303 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,19 +1,19 @@ package FS::cust_pkg; use strict; -use base qw( FS::cust_main_Mixin FS::location_Mixin - FS::m2m_Common FS::option_Common FS::Record - ); -use vars qw(@ISA $disable_agentcheck $DEBUG $me); +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common ); +use vars qw($disable_agentcheck $DEBUG $me); use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; -use Time::Local qw( timelocal_nocheck ); +use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); +use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -30,6 +30,7 @@ use FS::reason; use FS::cust_pkg_discount; use FS::discount; use FS::UI::Web; +use Data::Dumper; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -125,6 +126,10 @@ Billing item definition (see L) Optional link to package location (see L) +=item order_date + +date package was ordered (also remains same on changes) + =item start_date date @@ -153,13 +158,17 @@ date date +=item contract_end + +date + =item cancel date -=item otaker +=item usernum -order taker (assigned automatically if null, see L) +order taker (see L) =item manual_flag @@ -186,6 +195,8 @@ Previous pkgpart Previous locationnum +=item waive_setup + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -252,26 +263,36 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; - if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) { + my $error = $self->check_pkgpart; + return $error if $error; + + my $part_pkg = $self->part_pkg; + + if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) { my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5]; $mon += 1 unless $mday == 1; until ( $mon < 12 ) { $mon -= 12; $year++; } $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) ); } - my $expire_months = $self->part_pkg->option('expire_months', 1); - if ( $expire_months && !$self->expire ) { - my $start = $self->start_date || $self->setup || time; - - #false laziness w/part_pkg::add_freq - my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5]; - $mon += $expire_months; - until ( $mon < 12 ) { $mon -= 12; $year++; } + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $part_pkg->option("${action}_months",1); + if($months and !$self->$action) { + my $start = $self->start_date || $self->setup || time; + $self->$action( $part_pkg->add_freq($start, $months) ); + } + } - #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) ); - $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) ); + my $free_days = $part_pkg->option('free_days',1); + if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date + my ($mday,$mon,$year) = (localtime(time) )[3,4,5]; + #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days; + my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days; + $self->start_date($start_date); } + $self->order_date(time); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -283,7 +304,7 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); + $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -366,14 +387,70 @@ sub insert { This method now works but you probably shouldn't use it. -You don't want to delete billing items, because there would then be no record -the customer ever purchased the item. Instead, see the cancel method. +You don't want to delete packages, because there would then be no record +the customer ever purchased the package. Instead, see the cancel method and +hide cancelled packages. =cut -#sub delete { -# return "Can't delete cust_pkg records!"; -#} +sub delete { + my $self = shift; + + 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; + + foreach my $cust_pkg_discount ($self->cust_pkg_discount) { + my $error = $cust_pkg_discount->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #cust_bill_pkg_discount? + + foreach my $cust_pkg_detail ($self->cust_pkg_detail) { + my $error = $cust_pkg_detail->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + foreach my $cust_pkg_reason ( + qsearchs( { + 'table' => 'cust_pkg_reason', + 'hashref' => { 'pkgnum' => $self->pkgnum }, + } + ) + ) { + my $error = $cust_pkg_reason->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + #pkg_referral? + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ] @@ -425,7 +502,7 @@ sub replace { : { @_ }; #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; - return "Can't change otaker!" if $old->otaker ne $new->otaker; + #return "Can't change otaker!" if $old->otaker ne $new->otaker; #allow this *sigh* #return "Can't change setup once it exists!" @@ -488,7 +565,10 @@ sub replace { #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes foreach my $old_svc_acct ( @svc_acct ) { my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash }; - my $s_error = $new_svc_acct->replace($old_svc_acct); + my $s_error = + $new_svc_acct->replace( $old_svc_acct, + 'depend_jobnum' => $options->{depend_jobnum}, + ); if ( $s_error ) { $dbh->rollback if $oldAutoCommit; return $s_error; @@ -517,6 +597,7 @@ sub check { $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') + || $self->check_pkgpart || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') || $self->ut_numbern('start_date') || $self->ut_numbern('setup') @@ -525,10 +606,40 @@ sub check { || $self->ut_numbern('cancel') || $self->ut_numbern('adjourn') || $self->ut_numbern('expire') + || $self->ut_numbern('dundate') || $self->ut_enum('no_auto', [ '', 'Y' ]) + || $self->ut_enum('waive_setup', [ '', 'Y' ]) + || $self->ut_numbern('agent_pkgid') + || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ]) + || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ]) ; return $error if $error; + return "A package with both start date (future start) and setup date (already started) will never bill" + if $self->start_date && $self->setup; + + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; + + if ( $self->dbdef_table->column('manual_flag') ) { + $self->manual_flag('') if $self->manual_flag eq ' '; + $self->manual_flag =~ /^([01]?)$/ + or return "Illegal manual_flag ". $self->manual_flag; + $self->manual_flag($1); + } + + $self->SUPER::check; +} + +=item check_pkgpart + +=cut + +sub check_pkgpart { + my $self = shift; + + my $error = $self->ut_numbern('pkgpart'); + return $error if $error; + if ( $self->reg_code ) { unless ( grep { $self->pkgpart == $_->pkgpart } @@ -564,18 +675,8 @@ sub check { } - $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker"; - $self->otaker($1); - - if ( $self->dbdef_table->column('manual_flag') ) { - $self->manual_flag('') if $self->manual_flag eq ' '; - $self->manual_flag =~ /^([01]?)$/ - or return "Illegal manual_flag ". $self->manual_flag; - $self->manual_flag($1); - } + ''; - $self->SUPER::check; } =item cancel [ OPTION => VALUE ... ] @@ -598,6 +699,12 @@ Available options are: =item nobill - can be set true to skip billing if it might otherwise be done. +=item unused_credit - can be set to 1 to credit the remaining time, or 0 to +not credit it. This must be set (by change()) when changing the package +to a different pkgpart or location, and probably shouldn't be in any other +case. If it's not set, the 'unused_credit_cancel' part_pkg option will +be used. + =back If there is an error, returns the error, otherwise returns false. @@ -648,7 +755,6 @@ sub cancel { if $error; } - my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { @@ -663,39 +769,59 @@ sub cancel { } } - my %svc; - unless ( $date ) { - foreach my $cust_svc ( - #schwartz - map { $_->[0] } - sort { $a->[1] <=> $b->[1] } - map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - - my $error = $cust_svc->cancel; + my %svc_cancel_opt = (); + $svc_cancel_opt{'date'} = $date if $date; + foreach my $cust_svc ( + #schwartz + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = $cust_svc->part_svc; + next if ( defined($part_svc) and $part_svc->preserve ); + my $error = $cust_svc->cancel( %svc_cancel_opt ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; - } + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ). + " cust_svc: $error"; } + } + + unless ($date) { # Add a credit for remaining service - my $remaining_value = $self->calc_remain(time=>$cancel_time); - if ( $remaining_value > 0 && !$options{'no_credit'} ) { - my $error = $self->cust_main->credit( - $remaining_value, - 'Credit for unused time on '. $self->part_pkg->pkg, - 'reason_type' => $conf->config('cancel_credit_type'), - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return "Error crediting customer \$$remaining_value for unused time on". - $self->part_pkg->pkg. ": $error"; - } + my $last_bill = $self->getfield('last_bill') || 0; + my $next_bill = $self->getfield('bill') || 0; + my $do_credit; + if ( exists($options{'unused_credit'}) ) { + $do_credit = $options{'unused_credit'}; } - } + else { + $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); + } + if ( $do_credit + and $last_bill > 0 # the package has been billed + and $next_bill > 0 # the package has a next bill date + and $next_bill >= $cancel_time # which is in the future + ) { + my $remaining_value = $self->calc_remain('time' => $cancel_time); + if ( $remaining_value > 0 ) { + my $error = $self->cust_main->credit( + $remaining_value, + 'Credit for unused time on '. $self->part_pkg->pkg, + 'reason_type' => $conf->config('cancel_credit_type'), + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer \$$remaining_value for unused time". + " on ". $self->part_pkg->pkg. ": $error"; + } + } #if $remaining_value + } #if $do_credit + + } #unless $date my %hash = $self->hash; $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); @@ -710,13 +836,24 @@ sub cancel { return '' if $date; #no errors my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; - if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $error = send_email( - 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), - 'to' => \@invoicing_list, - 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - ); + if ( !$options{'quiet'} && + $conf->exists('emailcancel', $self->cust_main->agentnum) && + @invoicing_list ) { + my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum); + my $error = ''; + if ( $msgnum ) { + my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); + $error = $msg_template->send( 'cust_main' => $self->cust_main, + 'object' => $self ); + } + else { + $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + 'to' => \@invoicing_list, + 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), + 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + ); + } #should this do something on errors? } @@ -863,6 +1000,19 @@ sub suspend { } } + my %hash = $self->hash; + if ( $date ) { + $hash{'adjourn'} = $date; + } else { + $hash{'susp'} = $suspend_time; + } + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace( $self, options => { $self->options } ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + unless ( $date ) { my @labels = (); @@ -918,19 +1068,6 @@ sub suspend { } - my %hash = $self->hash; - if ( $date ) { - $hash{'adjourn'} = $date; - } else { - $hash{'susp'} = $suspend_time; - } - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors @@ -1017,10 +1154,16 @@ sub unsuspend { my $conf = new FS::Conf; - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if ( $opt{'adjust_next_bill'} - || $conf->exists('unsuspend-always_adjust_next_bill_date') ) - && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + if ( $inactive > 0 && + ( $hash{'bill'} || $hash{'setup'} ) && + ( $opt{'adjust_next_bill'} || + $conf->exists('unsuspend-always_adjust_next_bill_date') || + $self->part_pkg->option('unsuspend_adjust_bill', 1) ) + ) { + + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; + + } $hash{'susp'} = ''; $hash{'adjourn'} = '' if $hash{'adjourn'} < time; @@ -1106,7 +1249,7 @@ Options are: =over 4 -=item locaitonnum +=item locationnum New locationnum, to change the location for this package. @@ -1123,9 +1266,15 @@ New pkgpart (see L). New refnum (see L). +=item keep_dates + +Set to true to transfer billing dates (start_date, setup, last_bill, bill, +susp, adjourn, cancel, expire, and contract_end) to the new package. + =back -At least one option must be specified (otherwise, what's the point?) +At least one of locationnum, cust_location, pkgpart, refnum must be specified +(otherwise, what's the point?) Returns either the new FS::cust_pkg object or a scalar error. @@ -1183,6 +1332,24 @@ sub change { $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; } + my $unused_credit = 0; + if ( $opt->{'keep_dates'} ) { + foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire + start_date contract_end ) ) { + $hash{$date} = $self->getfield($date); + } + } + # Special case. If the pkgpart is changing, and the customer is + # going to be credited for remaining time, don't keep setup, bill, + # or last_bill dates, and DO pass the flag to cancel() to credit + # the customer. + if ( $opt->{'pkgpart'} + and $opt->{'pkgpart'} != $self->pkgpart + and $self->part_pkg->option('unused_credit_change', 1) ) { + $unused_credit = 1; + $hash{$_} = '' foreach qw(setup bill last_bill); + } + # Create the new package. my $cust_pkg = new FS::cust_pkg { custnum => $self->custnum, @@ -1232,7 +1399,7 @@ sub change { ? () : ( 'null' => 1 ) ) - if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover'); + if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1240,8 +1407,9 @@ sub change { } } - #Good to go, cancel old package. - $error = $self->cancel( quiet=>1 ); + #Good to go, cancel old package. Notify 'cancel' of whether to credit + #remaining time. + $error = $self->cancel( quiet=>1, unused_credit => $unused_credit ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -1262,6 +1430,59 @@ sub change { } +use Storable 'thaw'; +use MIME::Base64; +sub process_bulk_cust_pkg { + my $job = shift; + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + my $old_part_pkg = qsearchs('part_pkg', + { pkgpart => $param->{'old_pkgpart'} }); + my $new_part_pkg = qsearchs('part_pkg', + { pkgpart => $param->{'new_pkgpart'} }); + die "Must select a new package type\n" unless $new_part_pkg; + #my $keep_dates = $param->{'keep_dates'} || 0; + my $keep_dates = 1; # there is no good reason to turn this off + + 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 @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } ); + + my $i = 0; + foreach my $old_cust_pkg ( @cust_pkgs ) { + $i++; + $job->update_statustext(int(100*$i/(scalar @cust_pkgs))); + if ( $old_cust_pkg->getfield('cancel') ) { + warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '. + $old_cust_pkg->pkgnum."\n" + if $DEBUG; + next; + } + warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n" + if $DEBUG; + my $error = $old_cust_pkg->change( + 'pkgpart' => $param->{'new_pkgpart'}, + 'keep_dates' => $keep_dates + ); + if ( !ref($error) ) { # change returns the cust_pkg on success + $dbh->rollback; + die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n"; + } + } + $dbh->commit if $oldAutoCommit; + return; +} + =item last_bill Returns the last bill date, or if there is no last bill date, the setup date. @@ -1363,6 +1584,18 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item base_recur + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub base_recur { + my $self = shift; + $self->part_pkg->base_recur($self, @_); +} + =item calc_remain Calls the I of the FS::part_pkg object associated with this @@ -1547,24 +1780,33 @@ sub overlimit { grep { $_->overlimit } $self->cust_svc(@_); } -=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] Returns historical services for this package created before END TIMESTAMP and (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects -(see L). +(see L). If MODE is 'I' (for 'invoice'), services with the +I flag will be omitted. =cut sub h_cust_svc { my $self = shift; + warn "$me _h_cust_svc called on $self\n" + if $DEBUG; - $self->_sort_cust_svc( + my ($end, $start, $mode) = @_; + my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', - { 'pkgnum' => $self->pkgnum, }, - FS::h_cust_svc->sql_h_search(@_), - ) - ] + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) ] ); + if ( defined($mode) && $mode eq 'I' ) { + my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; + return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; + } else { + return @cust_svc; + } } sub _sort_cust_svc { @@ -1628,6 +1870,13 @@ sub available_part_svc { my $part_svc = $_->part_svc; $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking $_->quantity - $self->num_cust_svc($_->svcpart); + + # more evil encapsulation breakage + if($part_svc->{'Hash'}{'num_avail'} > 0) { + my @exports = $part_svc->part_export_did; + $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); + } + $part_svc; } $self->part_pkg->pkg_svc; @@ -1667,6 +1916,7 @@ sub part_svc { max( 0, $pkg_svc->quantity - $num_cust_svc ); $part_svc->{'Hash'}{'cust_pkg_svc'} = $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; + $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden; $part_svc; } $self->part_pkg->pkg_svc; @@ -1697,7 +1947,7 @@ sub extra_part_svc { my $self = shift; my $pkgnum = $self->pkgnum; - my $pkgpart = $self->pkgpart; + #my $pkgpart = $self->pkgpart; # qsearch( { # 'table' => 'part_svc', @@ -1716,23 +1966,27 @@ sub extra_part_svc { # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], # } ); -#seems to benchmark slightly faster... +#seems to benchmark slightly faster... (or did?) + + my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked; + my $pkgparts = join(',', @pkgparts); + qsearch( { #'select' => 'DISTINCT ON (svcpart) part_svc.*', #MySQL doesn't grok DISINCT ON 'select' => 'DISTINCT part_svc.*', 'table' => 'part_svc', 'addl_from' => - 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart - AND pkg_svc.pkgpart = ? + "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart IN ($pkgparts) AND quantity > 0 ) LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart ) LEFT JOIN cust_pkg USING ( pkgnum ) - ', + ", 'hashref' => {}, 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ", - 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], + 'extra_param' => [ [$self->pkgnum=>'int'] ], } ); } @@ -1768,6 +2022,16 @@ sub status { return 'active'; } +=item ucfirst_status + +Returns the status with the first character capitalized. + +=cut + +sub ucfirst_status { + ucfirst(shift->status); +} + =item statuses Class method that returns the list of possible status strings for packages @@ -1778,7 +2042,7 @@ Class method that returns the list of possible status strings for packages =cut tie my %statuscolor, 'Tie::IxHash', - 'not yet billed' => '000000', + 'not yet billed' => '009999', #teal? cyan? 'one-time charge' => '000000', 'active' => '00CC00', 'suspended' => 'FF9900', @@ -1872,11 +2136,12 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } -=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] Like the labels method, but returns historical information on services that were active as of END_TIMESTAMP and (optionally) not cancelled before -START_TIMESTAMP. +START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the +I flag will be omitted. Returns a list of lists, calling the label method for all (historical) services (see L) of this billing item. @@ -1885,6 +2150,8 @@ Returns a list of lists, calling the label method for all (historical) services sub h_labels { my $self = shift; + warn "$me _h_labels called on $self\n" + if $DEBUG; map { [ $_->label(@_) ] } $self->h_cust_svc(@_); } @@ -1917,31 +2184,53 @@ sub h_labels_short { sub _labels_short { my( $self, $method ) = ( shift, shift ); + warn "$me _labels_short called on $self with $method method\n" + if $DEBUG; + my $conf = new FS::Conf; my $max_same_services = $conf->config('cust_bill-max_same_services') || 5; + warn "$me _labels_short populating \%labels\n" + if $DEBUG; + my %labels; #tie %labels, 'Tie::IxHash'; push @{ $labels{$_->[0]} }, $_->[1] - foreach $self->h_labels(@_); + foreach $self->$method(@_); + + warn "$me _labels_short populating \@labels\n" + if $DEBUG; + my @labels; foreach my $label ( keys %labels ) { my %seen = (); my @values = grep { ! $seen{$_}++ } @{ $labels{$label} }; my $num = scalar(@values); + warn "$me _labels_short $num items for $label\n" + if $DEBUG; + if ( $num > $max_same_services ) { + warn "$me _labels_short more than $max_same_services, so summarizing\n" + if $DEBUG; push @labels, "$label ($num)"; } else { if ( $conf->exists('cust_bill-consolidate_services') ) { + warn "$me _labels_short consolidating services\n" + if $DEBUG; # push @labels, "$label: ". join(', ', @values); while ( @values ) { my $detail = "$label: "; $detail .= shift(@values). ', ' - while @values && length($detail.$values[0]) < 78; + while @values + && ( length($detail.$values[0]) < 78 || $detail eq "$label: " ); $detail =~ s/, $//; push @labels, $detail; } + warn "$me _labels_short done consolidating services\n" + if $DEBUG; } else { + warn "$me _labels_short adding service data\n" + if $DEBUG; push @labels, map { "$label: $_" } @values; } } @@ -2331,12 +2620,12 @@ sub insert_discount { 'discountnum' => $self->discountnum, 'months_used' => 0, 'end_date' => '', #XXX - 'otaker' => $self->otaker, #for the create a new discount case '_type' => $self->discountnum__type, 'amount' => $self->discountnum_amount, 'percent' => $self->discountnum_percent, 'months' => $self->discountnum_months, + 'setup' => $self->discountnum_setup, #'disabled' => $self->discountnum_disabled, }; @@ -2429,14 +2718,25 @@ sub onetime_sql { " where cust_pkg.pkgpart = part_pkg.pkgpart ) "; } +=item ordered_sql + +Returns an SQL expression identifying ordered packages (recurring packages not +yet billed). + +=cut + +sub ordered_sql { + $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql; +} + =item active_sql Returns an SQL expression identifying active packages. =cut -sub active_sql { " - ". $_[0]->recurring_sql(). " +sub active_sql { + $_[0]->recurring_sql. " AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) @@ -2497,6 +2797,22 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } +=item status_sql + +Returns an SQL expression to give the package status as a string. + +=cut + +sub status_sql { +"CASE + WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled' + WHEN cust_pkg.susp IS NOT NULL THEN 'suspended' + WHEN cust_pkg.setup IS NULL THEN 'not yet billed' + WHEN ".onetime_sql()." THEN 'one-time charge' + ELSE 'active' +END" +} + =item search HASHREF (Class method) @@ -2566,6 +2882,10 @@ a value suited to passing to FS::UI::Web::cust_header specifies the user for agent virtualization +=item fcc_line + + boolean selects packages containing fcc form 477 telco lines + =back =cut @@ -2593,6 +2913,15 @@ sub search { } ## + # custbatch + ## + + if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { + push @where, + "cust_pkg.pkgbatch = '$1'"; + } + + ## # parse status ## @@ -2627,45 +2956,56 @@ sub search { # parse package class ### - #false lazinessish w/graph/cust_bill_pkg.cgi - my $classnum = 0; - my @pkg_class = (); - if ( exists($params->{'classnum'}) - && $params->{'classnum'} =~ /^(\d*)$/ - ) - { - $classnum = $1; - if ( $classnum ) { #a specific class - push @where, "part_pkg.classnum = $classnum"; - - #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) ); - #die "classnum $classnum not found!" unless $pkg_class[0]; - #$title .= $pkg_class[0]->classname.' '; - - } elsif ( $classnum eq '' ) { #the empty class - - push @where, "part_pkg.classnum IS NULL"; - #$title .= 'Empty class '; - #@pkg_class = ( '(empty class)' ); - } elsif ( $classnum eq '0' ) { - #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } ); - #push @pkg_class, '(empty class)'; - } else { - die "illegal classnum"; + if ( exists($params->{'classnum'}) ) { + + my @classnum = (); + if ( ref($params->{'classnum'}) ) { + + if ( ref($params->{'classnum'}) eq 'HASH' ) { + @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} }; + } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) { + @classnum = @{ $params->{'classnum'} }; + } else { + die 'unhandled classnum ref '. $params->{'classnum'}; + } + + + } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) { + @classnum = ( $1 ); } + + if ( @classnum ) { + + my @c_where = (); + my @nums = grep $_, @classnum; + push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums; + my $null = scalar( grep { $_ eq '' } @classnum ); + push @c_where, 'part_pkg.classnum IS NULL' if $null; + + if ( scalar(@c_where) == 1 ) { + push @where, @c_where; + } elsif ( @c_where ) { + push @where, ' ( '. join(' OR ', @c_where). ' ) '; + } + warn $where[-1]; + + } + + } - #eslaf ### # parse package report options ### my @report_option = (); - if ( exists($params->{'report_option'}) - && $params->{'report_option'} =~ /^([,\d]*)$/ - ) - { - @report_option = split(',', $1); + if ( exists($params->{'report_option'}) ) { + if ( ref($params->{'report_option'}) eq 'ARRAY' ) { + @report_option = @{ $params->{'report_option'} }; + } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) { + @report_option = split(',', $1); + } + } if (@report_option) { @@ -2678,7 +3018,27 @@ sub search { } @report_option; } - #eslaf + foreach my $any ( grep /^report_option_any/, keys %$params ) { + + my @report_option_any = (); + if ( ref($params->{$any}) eq 'ARRAY' ) { + @report_option_any = @{ $params->{$any} }; + } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) { + @report_option_any = split(',', $1); + } + + if (@report_option_any) { + # this will result in the empty set for the dangling comma case as it should + push @where, ' ( '. join(' OR ', + map{ "0 < ( SELECT count(*) FROM part_pkg_option + WHERE part_pkg_option.pkgpart = part_pkg.pkgpart + AND optionname = 'report_option_$_' + AND optionvalue = '1' )" + } @report_option_any + ). ' ) '; + } + + } ### # parse custom @@ -2687,6 +3047,13 @@ sub search { push @where, "part_pkg.custom = 'Y'" if $params->{custom}; ### + # parse fcc_line + ### + + push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)" + if $params->{fcc_line}; + + ### # parse censustract ### @@ -2698,6 +3065,21 @@ sub search { } ### + # parse censustract2 + ### + if ( exists($params->{'censustract2'}) + && $params->{'censustract2'} =~ /^(\d*)$/ + ) + { + if ($1) { + push @where, "cust_main.censustract LIKE '$1%'"; + } else { + push @where, + "( cust_main.censustract = '' OR cust_main.censustract IS NULL )"; + } + } + + ### # parse part_pkg ### @@ -2736,21 +3118,32 @@ sub search { '' => {}, ); - foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) { + if( exists($params->{'active'} ) ) { + # This overrides all the other date-related fields + my($beginning, $ending) = @{$params->{'active'}}; + push @where, + "cust_pkg.setup IS NOT NULL", + "cust_pkg.setup <= $ending", + "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )", + "NOT (".FS::cust_pkg->onetime_sql . ")"; + } + else { + foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) { - next unless exists($params->{$field}); + next unless exists($params->{$field}); - my($beginning, $ending) = @{$params->{$field}}; + my($beginning, $ending) = @{$params->{$field}}; - next if $beginning == 0 && $ending == 4294967295; + next if $beginning == 0 && $ending == 4294967295; - push @where, - "cust_pkg.$field IS NOT NULL", - "cust_pkg.$field >= $beginning", - "cust_pkg.$field <= $ending"; + push @where, + "cust_pkg.$field IS NOT NULL", + "cust_pkg.$field >= $beginning", + "cust_pkg.$field <= $ending"; - $orderby ||= "ORDER BY cust_pkg.$field"; + $orderby ||= "ORDER BY cust_pkg.$field"; + } } $orderby ||= 'ORDER BY bill'; @@ -2833,6 +3226,35 @@ sub search { } +=item fcc_477_count + +Returns a list of two package counts. The first is a count of packages +based on the supplied criteria and the second is the count of residential +packages with those same criteria. Criteria are specified as in the search +method. + +=cut + +sub fcc_477_count { + my ($class, $params) = @_; + + my $sql_query = $class->search( $params ); + + my $count_sql = delete($sql_query->{'count_query'}); + $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/ + or die "couldn't parse count_sql"; + + my $count_sth = dbh->prepare($count_sql) + or die "Error preparing $count_sql: ". dbh->errstr; + $count_sth->execute + or die "Error executing $count_sql: ". $count_sth->errstr; + my $count_arrayref = $count_sth->fetchrow_arrayref; + + return ( @$count_arrayref ); + +} + + =item location_sql Returns a list: the first item is an SQL fragment identifying matching @@ -2922,6 +3344,15 @@ sub _location_sql_where { "; } +sub _X_show_zero { + my( $self, $what ) = @_; + + my $what_show_zero = $what. '_show_zero'; + length($self->$what_show_zero()) + ? ($self->$what_show_zero() eq 'Y') + : $self->part_pkg->$what_show_zero(); +} + =head1 SUBROUTINES =over 4 @@ -3127,6 +3558,31 @@ sub bulk_change { ''; } +# Used by FS::Upgrade to migrate to a new database. +sub _upgrade_data { # class method + my ($class, %opts) = @_; + $class->_upgrade_otaker(%opts); + my @statements = ( + # RT#10139, bug resulting in contract_end being set when it shouldn't + 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1', + # RT#10830, bad calculation of prorate date near end of year + # the date range for bill is December 2009, and we move it forward + # one year if it's before the previous bill date (which it should + # never be) + 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill + AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg + WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'', + # RT6628, add order_date to cust_pkg + 'update cust_pkg set order_date = (select history_date from h_cust_pkg + where h_cust_pkg.pkgnum = cust_pkg.pkgnum and + history_action = \'insert\') where order_date is null', + ); + foreach my $sql (@statements) { + my $sth = dbh->prepare($sql); + $sth->execute or die $sth->errstr; + } +} + =back =head1 BUGS