X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=ed9f2cbc6498dce55200472e8eade9e0f8653654;hb=947c955be56140c4a10b16345c1b15c44b02070a;hp=0c39f6868e5446435196636e7073103eff7bed44;hpb=c6eb405f6134173bc8306f45ddc697affa14123f;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 0c39f6868..ed9f2cbc6 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,9 +2,11 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG); +use Tie::IxHash; use FS::UID qw( getotaker dbh ); -use FS::Record qw( qsearch qsearchs ); use FS::Misc qw( send_email ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; @@ -12,10 +14,11 @@ use FS::type_pkgs; use FS::pkg_svc; use FS::cust_bill_pkg; use FS::h_cust_svc; +use FS::reg_code; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } -# because they load configuraion by setting FS::UID::callback (see TODO) +# because they load configuration by setting FS::UID::callback (see TODO) use FS::svc_acct; use FS::svc_domain; use FS::svc_www; @@ -24,7 +27,7 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( FS::Record ); +@ISA = qw( FS::cust_main_Mixin FS::Record ); $DEBUG = 0; @@ -140,6 +143,12 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } +sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_unlinked_msg { + my $self = shift; + "WARNING: can't find cust_main.custnum ". $self->custnum. + ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; +} =item insert [ OPTION => VALUE ... ] @@ -176,6 +185,15 @@ sub insert { return $error; } + #if ( $self->reg_code ) { + # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); + # $error = $reg_code->delete; + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return $error; + # } + #} + my $conf = new FS::Conf; my $cust_main = $self->cust_main; my $part_pkg = $self->part_pkg; @@ -247,6 +265,8 @@ suspend is normally updated by the suspend and unsuspend methods. cancel is normally updated by the cancel method (and also the order subroutine in some cases). +Calls + =cut sub replace { @@ -264,7 +284,51 @@ sub replace { local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart; - $new->SUPER::replace($old); + 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; + + #save off and freeze RADIUS attributes for any associated svc_acct records + my @svc_acct = (); + if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) { + + #also check for specific exports? + # to avoid spurious modify export events + @svc_acct = map { $_->svc_x } + grep { $_->part_svc->svcdb eq 'svc_acct' } + $old->cust_svc; + + $_->snapshot foreach @svc_acct; + + } + + my $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #for prepaid packages, + #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); + if ( $s_error ) { + $dbh->rollback if $oldAutoCommit; + return $s_error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + } =item check @@ -289,7 +353,17 @@ sub check { ; return $error if $error; - if ( $self->promo_code ) { + if ( $self->reg_code ) { + + unless ( grep { $self->pkgpart == $_->pkgpart } + map { $_->reg_code_pkg } + qsearchs( 'reg_code', { 'code' => $self->reg_code, + 'agentnum' => $self->cust_main->agentnum }) + ) { + return "Unknown registration code"; + } + + } elsif ( $self->promo_code ) { my $promo_part_pkg = qsearchs('part_pkg', { @@ -297,7 +371,6 @@ sub check { 'promo_code' => { op=>'ILIKE', value=>$self->promo_code }, } ); return 'Unknown promotional code' unless $promo_part_pkg; - $self->pkgpart($promo_part_pkg->pkgpart); } else { @@ -377,12 +450,16 @@ sub cancel { } # Add a credit for remaining service - my $remaining_value= $self->calc_remain(); - if ($remaining_value > 0) { - my $error = $self->credit($remaining_value, 'Credit for service remaining'); + my $remaining_value = $self->calc_remain(); + if ( $remaining_value > 0 ) { + my $error = $self->cust_main->credit( + $remaining_value, + 'Credit for unused time on '. $self->part_pkg->pkg, + ); if ($error) { $dbh->rollback if $oldAutoCommit; - return "Error crediting customer for service remaining: $error"; + return "Error crediting customer \$$remaining_value for unused time on". + $self->part_pkg->pkg. ": $error"; } } @@ -400,7 +477,7 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; + my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { my $conf = new FS::Conf; my $error = send_email( @@ -725,6 +802,73 @@ sub available_part_svc { $self->part_pkg->pkg_svc; } +=item status + +Returns a short status string for this package, currently: + +=over 4 + +=item not yet billed + +=item one-time charge + +=item active + +=item suspended + +=item cancelled + +=back + +=cut + +sub status { + my $self = shift; + + my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq; + + return 'cancelled' if $self->get('cancel'); + return 'suspended' if $self->susp; + return 'not yet billed' unless $self->setup; + return 'one-time charge' if $freq =~ /^(0|$)/; + return 'active'; +} + +=item statuses + +Class method that returns the list of possible status strings for pacakges +(see L). For example: + + @statuses = FS::cust_pkg->statuses(); + +=cut + +tie my %statuscolor, 'Tie::IxHash', + 'not yet billed' => '000000', + 'one-time charge' => '000000', + 'active' => '00CC00', + 'suspended' => 'FF9900', + 'cancelled' => 'FF0000', +; + +sub statuses { + my $self = shift; #could be class... + grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway + # mayble split btw one-time vs. recur + keys %statuscolor; +} + +=item statuscolor + +Returns a hex triplet color string for this package's status. + +=cut + +sub statuscolor { + my $self = shift; + $statuscolor{$self->status}; +} + =item labels Returns a list of lists, calling the label method for all services @@ -1039,6 +1183,86 @@ sub reexport { =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 active_sql + +Returns an SQL expression identifying active packages. + +=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 ) +"; } + +=item inactive_sql + +Returns an SQL expression identifying inactive packages (one-time packages +that are otherwise unsuspended/uncancelled). + +=cut + +sub inactive_sql { " + ". $_[0]->onetime_sql(). " + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) +"; } + +=item susp_sql +=item suspended_sql + +Returns an SQL expression identifying suspended packages. + +=cut + +sub suspended_sql { susp_sql(@_); } +sub susp_sql { + #$_[0]->recurring_sql(). ' AND '. + " + ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 + "; +} + +=item cancel_sql +=item cancelled_sql + +Returns an SQL exprression identifying cancelled packages. + +=cut + +sub cancelled_sql { cancel_sql(@_); } +sub cancel_sql { + #$_[0]->recurring_sql(). ' AND '. + "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; +} + =head1 SUBROUTINES =over 4 @@ -1083,12 +1307,23 @@ sub order { my $cust_main = qsearchs('cust_main', { custnum => $custnum }); return "Customer not found: $custnum" unless $cust_main; - my $change = scalar(@$remove_pkgnum) != 0; + my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } + @$remove_pkgnum; + + my $change = scalar(@old_cust_pkg) != 0; + + my %hash = (); + if ( scalar(@old_cust_pkg) == 1 ) { + #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); + $hash{'setup'} = time; + } # Create the new packages. foreach my $pkgpart (@$pkgparts) { my $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $pkgpart }; + pkgpart => $pkgpart, + %hash, + }; $error = $cust_pkg->insert( 'change' => $change ); if ($error) { $dbh->rollback if $oldAutoCommit; @@ -1100,8 +1335,7 @@ sub order { # created packages. # Transfer services and cancel old packages. - foreach my $old_pkgnum (@$remove_pkgnum) { - my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); + foreach my $old_pkg (@old_cust_pkg) { foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg);