X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=b3ed2f29a54965a4196b2ba12cce1eb2f6124f58;hp=a946de4dad63c94d34743e42ae36ecb9740ea10f;hb=b49c1bd5510a5f10b05bffacc6cc8b6a1b2153e8;hpb=8aa8e80791b7b99f4ac2e8e242fe83e1421c98d2 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index a946de4da..b3ed2f29a 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -125,6 +125,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 @@ -256,6 +260,9 @@ 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; @@ -271,6 +278,8 @@ sub insert { } } + $self->order_date(time); + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -282,7 +291,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; @@ -365,14 +374,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 ... ] @@ -487,7 +552,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; @@ -516,6 +584,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') @@ -528,6 +597,28 @@ sub check { ; return $error if $error; + $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 } @@ -563,16 +654,8 @@ sub check { } - $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 cancel [ OPTION => VALUE ... ] @@ -595,6 +678,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. @@ -645,7 +734,6 @@ sub cancel { if $error; } - my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { @@ -660,39 +748,57 @@ 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 $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); @@ -1203,12 +1309,23 @@ 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 { @@ -1267,8 +1384,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; @@ -1651,6 +1769,9 @@ I flag will be omitted. sub h_cust_svc { my $self = shift; + warn "$me _h_cust_svc called on $self\n" + if $DEBUG; + my ($end, $start, $mode) = @_; my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', @@ -1661,8 +1782,7 @@ sub h_cust_svc { if ( $mode eq 'I' ) { my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; - } - else { + } else { return @cust_svc; } } @@ -1728,6 +1848,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; @@ -1997,6 +2124,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(@_); } @@ -2029,31 +2158,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->$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; } } @@ -2443,7 +2594,6 @@ 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, @@ -3329,9 +3479,25 @@ sub bulk_change { sub _upgrade_data { # class method my ($class, %opts) = @_; $class->_upgrade_otaker(%opts); - my $sql =('UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1'); - my $sth = dbh->prepare($sql); - $sth->execute or die $sth->errstr; + 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