diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Cron/bill.pm | 15 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 1 | ||||
| -rw-r--r-- | FS/FS/cust_pkg.pm | 366 | ||||
| -rw-r--r-- | FS/FS/cust_pkg_reason.pm | 1 | ||||
| -rw-r--r-- | FS/FS/part_export/shellcommands.pm | 4 | ||||
| -rw-r--r-- | FS/FS/part_export/sqlradius.pm | 2 |
6 files changed, 290 insertions, 99 deletions
diff --git a/FS/FS/Cron/bill.pm b/FS/FS/Cron/bill.pm index 23fa064c6..df446d882 100644 --- a/FS/FS/Cron/bill.pm +++ b/FS/FS/Cron/bill.pm @@ -87,7 +87,12 @@ END foreach my $cust_pkg ( grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs ) { - my $error = $cust_pkg->cancel; + my $cpr = $cust_pkg->last_cust_pkg_reason('expire'); + my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, + 'reason_otaker' => $cpr->otaker + ) + : () + ); warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum $custnum: $error" if $error; @@ -101,7 +106,13 @@ END } $cust_main->ncancelled_pkgs ) { - my $error = $cust_pkg->suspend; + my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn') + if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T); + my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum, + 'reason_otaker' => $cpr->otaker + ) + : () + ); warn "Error suspending package ". $cust_pkg->pkgnum. " for custnum $custnum: $error" if $error; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 242bc0260..956aedd92 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -795,6 +795,7 @@ sub tables_hashref { 'num', 'serial', '', '', '', '', 'pkgnum', 'int', '', '', '', '', 'reasonnum','int', '', '', '', '', + 'action', 'char', 'NULL', 1, '', '', #should not be nullable 'otaker', 'varchar', '', 32, '', '', 'date', @date_type, '', '', ], diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 91a9b8114..42c3aca8c 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -320,7 +320,9 @@ sub replace { foreach my $method ( qw(adjourn expire) ) { # How many reasons? if ($options{'reason'} && $new->$method && $old->$method ne $new->$method) { my $error = $new->insert_reason( 'reason' => $options{'reason'}, - 'date' => $new->$method, + 'date' => $new->$method, + 'action' => $method, + 'reason_otaker' => $options{'reason_otaker'}, ); if ( $error ) { dbh->rollback if $oldAutoCommit; @@ -446,9 +448,11 @@ Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>) in this package, then cancels the package itself (sets the cancel field to now). -Available options are: I<quiet> +Available options are: I<quiet> I<reason> I<date> I<quiet> can be set true to supress email cancellation notices. +I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action +I<date> can be set to a unix style timestamp to specify when to cancel (expire) If there is an error, returns the error, otherwise returns false. @@ -469,8 +473,21 @@ sub cancel { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $old = $self->select_for_update; + + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + my $date = $options{date} if $options{date}; # expire/cancel later + $date = '' if ($date && $date <= time); # complain instead? + if ($options{'reason'}) { - $error = $self->insert_reason( 'reason' => $options{'reason'} ); + $error = $self->insert_reason( 'reason' => $options{'reason'}, + 'action' => $date ? 'expire' : 'cancel', + 'reason_otaker' => $options{'reason_otaker'}, + ); if ( $error ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; @@ -478,50 +495,51 @@ sub cancel { } my %svc; - 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 } ) - ) { + 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 $error = $cust_svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error cancelling cust_svc: $error"; + } } - } - # Add a credit for remaining service - my $remaining_value = $self->calc_remain(); - if ( $remaining_value > 0 ) { - my $conf = new FS::Conf; - 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"; - } - } - - unless ( $self->getfield('cancel') ) { - my %hash = $self->hash; - $hash{'cancel'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + # Add a credit for remaining service + my $remaining_value = $self->calc_remain(); + if ( $remaining_value > 0 ) { + my $conf = new FS::Conf; + 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 %hash = $self->hash; + $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = 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; + return '' if $date; #no errors my $conf = new FS::Conf; my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; @@ -540,11 +558,68 @@ sub cancel { } -=item suspend +=item unexpire + +Cancels any pending expiration (sets the expire field to null). + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub unexpire { + my( $self, %options ) = @_; + my $error; + + 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 $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unexpire cancelled package $pkgnum"; + # or at least it's pointless + } + + unless ( $old->get('expire') && $self->get('expire') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + my %hash = $self->hash; + $hash{'expire'} = ''; + 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 + +} + +=item suspend [ OPTION => VALUE ... ] Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this package, then suspends the package itself (sets the susp field to now). +Available options are: I<reason> I<date> + +I<date> can be set to a unix style timestamp to specify when to suspend (adjourn) +I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action + If there is an error, returns the error, otherwise returns false. =cut @@ -564,46 +639,69 @@ sub suspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't suspend cancelled package $pkgnum"; + } + + if ( $old->get('susp') || $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error # complain on adjourn? + } + + my $date = $options{date} if $options{date}; # adjourn/suspend later + $date = '' if ($date && $date <= time); # complain instead? + + if ( $date && $old->get('expire') && $old->get('expire') < $date ) { + dbh->rollback if $oldAutoCommit; + return "Package $pkgnum expires before it would be suspended."; + } + if ($options{'reason'}) { - $error = $self->insert_reason( 'reason' => $options{'reason'} ); + $error = $self->insert_reason( 'reason' => $options{'reason'}, + 'action' => $date ? 'adjourn' : 'suspend', + 'reason_otaker' => $options{'reason_otaker'}, + ); if ( $error ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; } } - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; + unless ( $date ) { + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->suspend; - if ( $error ) { + $part_svc->svcdb =~ /^([\w\-]+)$/ or do { $dbh->rollback if $oldAutoCommit; - return $error; + return "Illegal svcdb value in part_svc!"; + }; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); + if ($svc) { + $error = $svc->suspend; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } - } - unless ( $self->getfield('susp') ) { - my %hash = $self->hash; - $hash{'susp'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } + my %hash = $self->hash; + $date ? ($hash{'adjourn'} = $date) : ($hash{'susp'} = 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; @@ -645,6 +743,19 @@ sub unsuspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unsuspend cancelled package $pkgnum"; + } + + unless ( $old->get('susp') && $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error # complain instead? + } + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -668,25 +779,23 @@ sub unsuspend { } - unless ( ! $self->getfield('susp') ) { - my %hash = $self->hash; - my $inactive = time - $hash{'susp'}; + my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; - my $conf = new FS::Conf; + my $conf = new FS::Conf; - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if ( $opt{'adjust_next_bill'} - || $conf->config('unsuspend-always_adjust_next_bill_date') ) - && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if ( $opt{'adjust_next_bill'} + || $conf->config('unsuspend-always_adjust_next_bill_date') ) + && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); - $hash{'susp'} = ''; - $hash{'adjourn'} = '' if $hash{'adjourn'} < time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } + $hash{'susp'} = ''; + $hash{'adjourn'} = '' if $hash{'adjourn'} < 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; @@ -694,6 +803,64 @@ sub unsuspend { ''; #no errors } +=item unadjourn + +Cancels any pending suspension (sets the adjourn field to null). + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub unadjourn { + my( $self, %options ) = @_; + my $error; + + 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 $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unadjourn cancelled package $pkgnum"; + # or at least it's pointless + } + + if ( $old->get('susp') || $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unadjourn suspended package $pkgnum"; + # perhaps this is arbitrary + } + + unless ( $old->get('adjourn') && $self->get('adjourn') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + my %hash = $self->hash; + $hash{'adjourn'} = ''; + 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 + +} + =item last_bill Returns the last bill date, or if there is no last bill date, the setup date. @@ -712,30 +879,37 @@ sub last_bill { $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; } -=item last_cust_pkg_reason +=item last_cust_pkg_reason ACTION -Returns the most recent FS::reason associated with the package. +Returns the most recent ACTION FS::cust_pkg_reason associated with the package. +Returns false if there is no reason or the package is not currenly ACTION'd +ACTION is one of adjourn, susp, cancel, or expire. =cut sub last_cust_pkg_reason { - my $self = shift; + my ( $self, $action ) = ( shift, shift ); + my $date = $self->get($action); qsearchs( { 'table' => 'cust_pkg_reason', - 'hashref' => { 'pkgnum' => $self->pkgnum, }, - 'extra_sql'=> "AND date <= ". time, - 'order_by' => 'ORDER BY date DESC LIMIT 1', + 'hashref' => { 'pkgnum' => $self->pkgnum, + 'action' => substr(uc($action), 0, 1), + 'date' => $date, + }, + 'order_by' => 'ORDER BY num DESC LIMIT 1', } ); } -=item last_reason +=item last_reason ACTION -Returns the most recent FS::reason associated with the package. +Returns the most recent ACTION FS::reason associated with the package. +Returns false if there is no reason or the package is not currenly ACTION'd +ACTION is one of adjourn, susp, cancel, or expire. =cut sub last_reason { - my $cust_pkg_reason = shift->last_cust_pkg_reason; + my $cust_pkg_reason = shift->last_cust_pkg_reason(@_); $cust_pkg_reason->reason if $cust_pkg_reason; } @@ -1718,12 +1892,12 @@ sub search_sql { qsearchs('access_user', { username => $params->{CurrentUser} }); if ($access_user) { - push @where, $access_user->agentnums_sql; + push @where, $access_user->agentnums_sql('table' => 'cust_main'); }else{ push @where, "1=0"; } }else{ - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql; + push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main'); } my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; @@ -1954,7 +2128,8 @@ sub bulk_change { sub insert_reason { my ($self, %options) = @_; - my $otaker = $FS::CurrentUser::CurrentUser->username; + my $otaker = $options{reason_otaker} || + $FS::CurrentUser::CurrentUser->username; my $reasonnum; if ( $options{'reason'} =~ /^(\d+)$/ ) { @@ -1983,6 +2158,7 @@ sub insert_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, diff --git a/FS/FS/cust_pkg_reason.pm b/FS/FS/cust_pkg_reason.pm index 24808f944..92cd4a1f9 100644 --- a/FS/FS/cust_pkg_reason.pm +++ b/FS/FS/cust_pkg_reason.pm @@ -98,6 +98,7 @@ sub check { $self->ut_numbern('num') || $self->ut_number('pkgnum') || $self->ut_number('reasonnum') + || $self->ut_enum('action', [ 'A', 'C', 'E', 'S' ]) || $self->ut_text('otaker') || $self->ut_numbern('date') ; diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index b43033405..107106897 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -253,7 +253,9 @@ sub _export_command { @radius_groups = $svc_acct->radius_groups; my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext); - if ( $cust_pkg && $action eq 'suspend' && (my $r = $cust_pkg->last_reason) ) { + if ( $cust_pkg && $action eq 'suspend' && + (my $r = $cust_pkg->last_reason('susp')) ) + { $reasonnum = $r->reasonnum; $reasontext = $r->reason; $reasontypenum = $r->reason_type; diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 3c25a99ee..88b7ed399 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -311,7 +311,7 @@ sub suspended_usergroups { #false laziness with FS::part_export::shellcommands #subclass part_export? - my $r = $svc_acct->cust_svc->cust_pkg->last_reason; + my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp'); my %reasonmap = $self->_groups_susp_reason_map; my $userspec = ''; if ($r) { |