use strict;
use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
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;
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;
# for sending cancel emails in sub cancel
use FS::Conf;
-@ISA = qw( FS::Record );
+@ISA = qw( FS::cust_main_Mixin FS::Record );
$DEBUG = 0;
=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 ... ]
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;
cancel is normally updated by the cancel method (and also the order subroutine
in some cases).
+Calls
+
=cut
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
;
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', {
'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
} );
return 'Unknown promotional code' unless $promo_part_pkg;
- $self->pkgpart($promo_part_pkg->pkgpart);
} else {
}
# 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";
}
}
$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(
=cut
-sub calc_recur {
+sub calc_remain {
my $self = shift;
$self->part_pkg->calc_remain($self, @_);
}
$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;
+
+ return 'cancelled' if $self->get('cancel');
+ return 'suspended' if $self->susp;
+ return 'not yet billed' unless $self->setup;
+ return 'one-time charge' if $self->part_pkg->freq =~ /^(0|$)/;
+ return 'active';
+}
+
+=item statuscolor
+
+Returns a hex triplet color string for this package's status.
+
+=cut
+
+my %statuscolor = (
+ 'not yet billed' => '000000',
+ 'one-time charge' => '000000',
+ 'active' => '00CC00',
+ 'suspended' => 'FF9900',
+ 'cancelled' => 'FF0000',
+);
+sub statuscolor {
+ my $self = shift;
+ $statuscolor{$self->status};
+}
+
=item labels
Returns a list of lists, calling the label method for all services
=back
+=head1 CLASS METHOD
+
+=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 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 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
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;
# 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);
projects / freeside.git / blobdiff