X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=07b71dc113afb448e5dceb7cce854239f340c936;hp=e4846ec34eeb5ff56c7f6e045932afefc2aeda5f;hb=077bb34b3467c3320440c49b76064f664c0eee98;hpb=00156a6b621cc0e0227564ebbc53bda3aeb9dc14 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index e4846ec34..07b71dc11 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,17 +1,19 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +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 MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); -use FS::m2m_Common; -use FS::cust_main_Mixin; +use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -25,7 +27,10 @@ use FS::reg_code; use FS::part_svc; use FS::cust_pkg_reason; 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 } @@ -38,9 +43,8 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record ); - $DEBUG = 0; +$me = '[FS::cust_pkg]'; $disable_agentcheck = 0; @@ -122,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 @@ -150,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 @@ -183,6 +195,8 @@ Previous pkgpart Previous locationnum +=item waive_setup + =back Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date @@ -249,6 +263,26 @@ an optional queue name for ticket additions sub insert { my( $self, %options ) = @_; + my $error = $self->check_pkgpart; + return $error if $error; + + if ( $self->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) ); + } + + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $self->part_pkg->option("${action}_months",1); + if($months and !$self->$action) { + my $start = $self->start_date || $self->setup || time; + $self->$action( $self->part_pkg->add_freq($start, $months) ); + } + } + + $self->order_date(time); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -260,7 +294,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; @@ -273,6 +307,14 @@ sub insert { 'params' => $self->refnum, ); + if ( $self->discountnum ) { + my $error = $self->insert_discount(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #if ( $self->reg_code ) { # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); # $error = $reg_code->delete; @@ -285,14 +327,18 @@ sub insert { my $conf = new FS::Conf; if ( $conf->config('ticket_system') && $options{ticket_subject} ) { - eval ' - use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); - use RT; - '; - die $@ if $@; - - RT::LoadConfig(); - RT::Init(); + + #eval ' + # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + # use RT; + #'; + #die $@ if $@; + # + #RT::LoadConfig(); + #RT::Init(); + use FS::TicketSystem; + FS::TicketSystem->init(); + my $q = new RT::Queue($RT::SystemUser); $q->Load($options{ticket_queue}) if $options{ticket_queue}; my $t = new RT::Ticket($RT::SystemUser); @@ -331,14 +377,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 ... ] @@ -390,7 +492,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!" @@ -453,7 +555,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; @@ -482,6 +587,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') @@ -490,9 +596,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 } @@ -528,18 +665,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 ... ] @@ -562,6 +689,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. @@ -612,7 +745,6 @@ sub cancel { if $error; } - my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { @@ -627,39 +759,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); @@ -674,13 +826,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? } @@ -981,10 +1144,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; @@ -1070,7 +1239,7 @@ Options are: =over 4 -=item locaitonnum +=item locationnum New locationnum, to change the location for this package. @@ -1087,9 +1256,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. @@ -1147,6 +1322,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, @@ -1196,7 +1389,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; @@ -1204,18 +1397,82 @@ 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; + $dbh->rollback if $oldAutoCommit; return $error; } + if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { + #$self->cust_main + my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $cust_pkg; } +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. @@ -1317,6 +1574,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 @@ -1501,31 +1770,43 @@ 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 ( $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 { my( $self, $arrayref ) = @_; + my $sort = + sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }; + map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + sort $sort map { my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, 'svcpart' => $_->svcpart } ); @@ -1579,6 +1860,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; @@ -1618,6 +1906,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; @@ -1669,7 +1958,9 @@ sub extra_part_svc { #seems to benchmark slightly faster... qsearch( { - 'select' => 'DISTINCT ON (svcpart) part_svc.*', + #'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 @@ -1717,6 +2008,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 @@ -1727,7 +2028,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', @@ -1821,11 +2122,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. @@ -1834,6 +2136,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(@_); } @@ -1866,31 +2170,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; } } @@ -1911,29 +2237,24 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin + =item cust_location Returns the location object, if any (see L). -=cut - -sub cust_location { - my $self = shift; - return '' unless $self->locationnum; - qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); -} - =item cust_location_or_main If this package is associated with a location, returns the locaiton (see L), otherwise returns the customer (see L). +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L). + =cut -sub cust_location_or_main { - my $self = shift; - $self->cust_location || $self->cust_main; -} +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin =item seconds_since TIMESTAMP @@ -2185,57 +2506,239 @@ sub reexport { } -=back +=item insert_reason -=head1 CLASS METHODS +Associates this package with a (suspension or cancellation) reason (see +L, possibly inserting a new reason on the fly (see +L). + +Available options are: =over 4 -=item recurring_sql +=item reason -Returns an SQL expression identifying recurring packages. +can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L, reason - Text of the new reason. -=cut +=item reason_otaker -sub recurring_sql { " - '0' != ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; } +the access_user (see L) providing the reason -=item onetime_sql +=item date -Returns an SQL expression identifying one-time packages. +a unix timestamp -=cut +=item action -sub onetime_sql { " - '0' = ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; } +the action (cancel, susp, adjourn, expire) associated with the reason -=item active_sql +=back -Returns an SQL expression identifying active packages. +If there is an error, returns the error, otherwise returns false. =cut -sub active_sql { " - ". $_[0]->recurring_sql(). " - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) -"; } +sub insert_reason { + my ($self, %options) = @_; -=item not_yet_billed_sql + my $otaker = $options{reason_otaker} || + $FS::CurrentUser::CurrentUser->username; -Returns an SQL expression identifying packages which have not yet been billed. + my $reasonnum; + if ( $options{'reason'} =~ /^(\d+)$/ ) { -=cut + $reasonnum = $1; -sub not_yet_billed_sql { " - ( cust_pkg.setup IS NULL OR 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 ) -"; } + } elsif ( ref($options{'reason'}) ) { + + return 'Enter a new reason (or select an existing one)' + unless $options{'reason'}->{'reason'} !~ /^\s*$/; + + my $reason = new FS::reason({ + 'reason_type' => $options{'reason'}->{'typenum'}, + 'reason' => $options{'reason'}->{'reason'}, + }); + my $error = $reason->insert; + return $error if $error; + + $reasonnum = $reason->reasonnum; + + } else { + return "Unparsable reason: ". $options{'reason'}; + } + + my $cust_pkg_reason = + new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, + 'reasonnum' => $reasonnum, + 'otaker' => $otaker, + 'action' => substr(uc($options{'action'}),0,1), + 'date' => $options{'date'} + ? $options{'date'} + : time, + }); + + $cust_pkg_reason->insert; +} + +=item insert_discount + +Associates this package with a discount (see L, possibly +inserting a new discount on the fly (see L). + +Available options are: + +=over 4 + +=item discountnum + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_discount { + #my ($self, %options) = @_; + my $self = shift; + + my $cust_pkg_discount = new FS::cust_pkg_discount { + 'pkgnum' => $self->pkgnum, + 'discountnum' => $self->discountnum, + 'months_used' => 0, + 'end_date' => '', #XXX + #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, + }; + + $cust_pkg_discount->insert; +} + +=item set_usage USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values reset. + +=cut + +sub set_usage { + my ($self, $valueref, %opt) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->set_usage($valueref, %opt) + if $svc_x->can("set_usage"); + } +} + +=item recharge USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values incremented. + +=cut + +sub recharge { + my ($self, $valueref) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->recharge($valueref) + if $svc_x->can("recharge"); + } +} + +=item cust_pkg_discount + +=cut + +sub cust_pkg_discount { + my $self = shift; + qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } ); +} + +=item cust_pkg_discount_active + +=cut + +sub cust_pkg_discount_active { + my $self = shift; + grep { $_->status eq 'active' } $self->cust_pkg_discount; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item recurring_sql + +Returns an SQL expression identifying recurring packages. + +=cut + +sub recurring_sql { " + '0' != ( select freq from part_pkg + where cust_pkg.pkgpart = part_pkg.pkgpart ) +"; } + +=item onetime_sql + +Returns an SQL expression identifying one-time packages. + +=cut + +sub onetime_sql { " + '0' = ( select freq from part_pkg + 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. " + 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 ) +"; } + +=item not_yet_billed_sql + +Returns an SQL expression identifying packages which have not yet been billed. + +=cut + +sub not_yet_billed_sql { " + ( cust_pkg.setup IS NULL OR 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 ) +"; } =item inactive_sql @@ -2280,7 +2783,23 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HASHREF +=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) @@ -2349,11 +2868,15 @@ 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 -sub search_sql { +sub search { my ($class, $params) = @_; my @where = (); @@ -2376,6 +2899,15 @@ sub search_sql { } ## + # custbatch + ## + + if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { + push @where, + "cust_pkg.pkgbatch = '$1'"; + } + + ## # parse status ## @@ -2384,8 +2916,8 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'not yet billed' - || $params->{'status'} eq 'not yet billed' ) { + } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/ + || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) { push @where, FS::cust_pkg->not_yet_billed_sql(); @@ -2419,7 +2951,7 @@ sub search_sql { { $classnum = $1; if ( $classnum ) { #a specific class - push @where, "classnum = $classnum"; + push @where, "part_pkg.classnum = $classnum"; #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) ); #die "classnum $classnum not found!" unless $pkg_class[0]; @@ -2427,7 +2959,7 @@ sub search_sql { } elsif ( $classnum eq '' ) { #the empty class - push @where, "classnum IS NULL"; + push @where, "part_pkg.classnum IS NULL"; #$title .= 'Empty class '; #@pkg_class = ( '(empty class)' ); } elsif ( $classnum eq '0' ) { @@ -2470,6 +3002,12 @@ sub search_sql { push @where, "part_pkg.custom = 'Y'" if $params->{custom}; ### + # parse fcc_line + ### + + push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line}; + + ### # parse censustract ### @@ -2519,21 +3057,32 @@ sub search_sql { '' => {}, ); - 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'; @@ -2582,10 +3131,10 @@ sub search_sql { if ($access_user) { push @where, $access_user->agentnums_sql('table'=>'cust_main'); - }else{ + } else { push @where, "1=0"; } - }else{ + } else { push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main'); } @@ -2593,7 +3142,7 @@ sub search_sql { my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class USING ( classnum ) '; + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; @@ -2604,7 +3153,7 @@ sub search_sql { 'cust_pkg.*', ( map "part_pkg.$_", qw( pkg freq ) ), 'pkg_class.classname', - 'cust_main.custnum as cust_main_custnum', + 'cust_main.custnum AS cust_main_custnum', FS::UI::Web::cust_sql_fields( $params->{'cust_fields'} ), @@ -2616,6 +3165,35 @@ sub search_sql { } +=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 @@ -2632,13 +3210,8 @@ sub location_sql { my $conf = new FS::Conf; # '?' placeholders in _location_sql_where - my @bill_param; - if ( $ornull ) { - @bill_param = qw( county county state state state country ); - } else { - @bill_param = qw( county state state country ); - } - unshift @bill_param, 'county'; # unless $nec; + my $x = $ornull ? 3 : 2; + my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); my $main_where; my @main_param; @@ -2697,16 +3270,28 @@ sub _location_sql_where { $ornull = $ornull ? ' OR ? IS NULL ' : ''; + my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) "; my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; +# ( $table.${prefix}city = ? $or_empty_city $ornull ) " - ( $table.${prefix}county = ? $or_empty_county $ornull ) + ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL ) + AND ( $table.${prefix}county = ? $or_empty_county $ornull ) AND ( $table.${prefix}state = ? $or_empty_state $ornull ) AND $table.${prefix}country = ? "; } +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 @@ -2757,6 +3342,9 @@ sub order { # my $cust_main = qsearchs('cust_main', { custnum => $custnum }); # return "Customer not found: $custnum" unless $cust_main; + warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n" + if $DEBUG; + my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } @$remove_pkgnum; @@ -2765,6 +3353,10 @@ sub order { my %hash = (); if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) { + warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum. + " to pkgpart ". $pkgparts->[0]. "\n" + if $DEBUG; + my $err_or_cust_pkg = $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0], 'refnum' => $refnum, @@ -2776,12 +3368,16 @@ sub order { } push @$return_cust_pkg, $err_or_cust_pkg; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } # Create the new packages. foreach my $pkgpart (@$pkgparts) { + + warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG; + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, pkgpart => $pkgpart, refnum => $refnum, @@ -2800,6 +3396,9 @@ sub order { # Transfer services and cancel old packages. foreach my $old_pkg (@old_cust_pkg) { + warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n" + if $DEBUG; + foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg); if ($error and $error == 0) { @@ -2898,117 +3497,28 @@ sub bulk_change { ''; } -=item insert_reason - -Associates this package with a (suspension or cancellation) reason (see -L, possibly inserting a new reason on the fly (see -L). - -Available options are: - -=over 4 - -=item reason - -can be set to a cancellation reason (see L), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L, reason - Text of the new reason. - -=item reason_otaker - -the access_user (see L) providing the reason - -=item date - -a unix timestamp - -=item action - -the action (cancel, susp, adjourn, expire) associated with the reason - -=back - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub insert_reason { - my ($self, %options) = @_; - - my $otaker = $options{reason_otaker} || - $FS::CurrentUser::CurrentUser->username; - - my $reasonnum; - if ( $options{'reason'} =~ /^(\d+)$/ ) { - - $reasonnum = $1; - - } elsif ( ref($options{'reason'}) ) { - - return 'Enter a new reason (or select an existing one)' - unless $options{'reason'}->{'reason'} !~ /^\s*$/; - - my $reason = new FS::reason({ - 'reason_type' => $options{'reason'}->{'typenum'}, - 'reason' => $options{'reason'}->{'reason'}, - }); - my $error = $reason->insert; - return $error if $error; - - $reasonnum = $reason->reasonnum; - - } else { - return "Unparsable reason: ". $options{'reason'}; - } - - my $cust_pkg_reason = - new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, - 'reasonnum' => $reasonnum, - 'otaker' => $otaker, - 'action' => substr(uc($options{'action'}),0,1), - 'date' => $options{'date'} - ? $options{'date'} - : time, - }); - - $cust_pkg_reason->insert; -} - -=item set_usage USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values reset. - -=cut - -sub set_usage { - my ($self, $valueref, %opt) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref, %opt) - if $svc_x->can("set_usage"); - } -} - -=item recharge USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values incremented. - -=cut - -sub recharge { - my ($self, $valueref) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->recharge($valueref) - if $svc_x->can("recharge"); +# 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; } }