+=item decrement_upbytes OCTETS
+
+Decrements the I<upbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_upbytes {
+ shift->_op_usage('-', 'upbytes', @_);
+}
+
+=item increment_upbytes OCTETS
+
+Increments the I<upbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_upbytes {
+ shift->_op_usage('+', 'upbytes', @_);
+}
+
+=item decrement_downbytes OCTETS
+
+Decrements the I<downbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_downbytes {
+ shift->_op_usage('-', 'downbytes', @_);
+}
+
+=item increment_downbytes OCTETS
+
+Increments the I<downbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_downbytes {
+ shift->_op_usage('+', 'downbytes', @_);
+}
+
+=item decrement_totalbytes OCTETS
+
+Decrements the I<totalbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_totalbytes {
+ shift->_op_usage('-', 'totalbytes', @_);
+}
+
+=item increment_totalbytes OCTETS
+
+Increments the I<totalbytes> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_totalbytes {
+ shift->_op_usage('+', 'totalbytes', @_);
+}
+
+=item decrement_seconds SECONDS
+
+Decrements the I<seconds> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_seconds {
+ shift->_op_usage('-', 'seconds', @_);
+}
+
+=item increment_seconds SECONDS
+
+Increments the I<seconds> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_seconds {
+ shift->_op_usage('+', 'seconds', @_);
+}
+
+
+my %op2action = (
+ '-' => 'suspend',
+ '+' => 'unsuspend',
+);
+my %op2condition = (
+ '-' => sub { my($self, $column, $amount) = @_;
+ $self->$column - $amount <= 0;
+ },
+ '+' => sub { my($self, $column, $amount) = @_;
+ $self->$column + $amount > 0;
+ },
+);
+my %op2warncondition = (
+ '-' => sub { my($self, $column, $amount) = @_;
+ my $threshold = $column . '_threshold';
+ $self->$column - $amount <= $self->$threshold + 0;
+ },
+ '+' => sub { my($self, $column, $amount) = @_;
+ $self->$column + $amount > 0;
+ },
+);
+
+sub _op_usage {
+ my( $self, $op, $column, $amount ) = @_;
+
+ warn "$me _op_usage called for $column on svcnum ". $self->svcnum.
+ ' ('. $self->email. "): $op $amount\n"
+ if $DEBUG;
+
+ return '' unless $amount;
+
+ 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 $sql = "UPDATE svc_acct SET $column = ".
+ " CASE WHEN $column IS NULL THEN 0 ELSE $column END ". #$column||0
+ " $op ? WHERE svcnum = ?";
+ warn "$me $sql\n"
+ if $DEBUG;
+
+ my $sth = $dbh->prepare( $sql )
+ or die "Error preparing $sql: ". $dbh->errstr;
+ my $rv = $sth->execute($amount, $self->svcnum);
+ die "Error executing $sql: ". $sth->errstr
+ unless defined($rv);
+ die "Can't update $column for svcnum". $self->svcnum
+ if $rv == 0;
+
+ my $action = $op2action{$op};
+
+ if ( &{$op2condition{$op}}($self, $column, $amount) ) {
+ foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+ if ($part_export->option('overlimit_groups')) {
+ my ($new,$old);
+ my $other = new FS::svc_acct $self->hashref;
+ my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
+ ($self, $part_export->option('overlimit_groups'));
+ $other->usergroup( $groups );
+ if ($action eq 'suspend'){
+ $new = $other; $old = $self;
+ }else{
+ $new = $self; $old = $other;
+ }
+ my $error = $part_export->export_replace($new, $old);
+ $error ||= $self->overlimit($action);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing radius groups in export, ${op}: $error";
+ }
+ }
+ }
+ }
+
+ if ( $conf->exists("svc_acct-usage_$action")
+ && &{$op2condition{$op}}($self, $column, $amount) ) {
+ #my $error = $self->$action();
+ my $error = $self->cust_svc->cust_pkg->$action();
+ $error ||= $self->overlimit($action);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error ${action}ing: $error";
+ }
+ }
+
+ if ($warning_template && &{$op2warncondition{$op}}($self, $column, $amount)) {
+ my $wqueue = new FS::queue {
+ 'svcnum' => $self->svcnum,
+ 'job' => 'FS::svc_acct::reached_threshold',
+ };
+
+ my $to = '';
+ if ($op eq '-'){
+ $to = $warning_cc if &{$op2condition{$op}}($self, $column, $amount);
+ }
+
+ # x_threshold race
+ my $error = $wqueue->insert(
+ 'svcnum' => $self->svcnum,
+ 'op' => $op,
+ 'column' => $column,
+ 'to' => $to,
+ );
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error queuing threshold activity: $error";
+ }
+ }
+
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+sub set_usage {
+ my( $self, $valueref ) = @_;
+
+ warn "$me set_usage called for svcnum ". $self->svcnum.
+ ' ('. $self->email. "): ".
+ join(', ', map { "$_ => " . $valueref->{$_}} keys %$valueref) . "\n"
+ if $DEBUG;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ local $FS::svc_Common::noexport_hack = 1;
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $reset = 0;
+ my %handyhash = ();
+ foreach my $field (keys %$valueref){
+ $reset = 1 if $valueref->{$field};
+ $self->setfield($field, $valueref->{$field});
+ $self->setfield( $field.'_threshold',
+ int($self->getfield($field)
+ * ( $conf->exists('svc_acct-usage_threshold')
+ ? 1 - $conf->config('svc_acct-usage_threshold')/100
+ : 0.20
+ )
+ )
+ );
+ $handyhash{$field} = $self->getfield($field);
+ $handyhash{$field.'_threshold'} = $self->getfield($field.'_threshold');
+ }
+ #my $error = $self->replace; #NO! we avoid the call to ->check for
+ #die $error if $error; #services not explicity changed via the UI
+
+ my $sql = "UPDATE svc_acct SET " .
+ join (',', map { "$_ = ?" } (keys %handyhash) ).
+ " WHERE svcnum = ?";
+
+ warn "$me $sql\n"
+ if $DEBUG;
+
+ if (scalar(keys %handyhash)) {
+ my $sth = $dbh->prepare( $sql )
+ or die "Error preparing $sql: ". $dbh->errstr;
+ my $rv = $sth->execute((grep{$_} values %handyhash), $self->svcnum);
+ die "Error executing $sql: ". $sth->errstr
+ unless defined($rv);
+ die "Can't update usage for svcnum ". $self->svcnum
+ if $rv == 0;
+ }
+
+ if ( $reset ) {
+ my $error = $self->overlimit('unsuspend');
+
+ foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+ if ($part_export->option('overlimit_groups')) {
+ my $old = new FS::svc_acct $self->hashref;
+ my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
+ ($self, $part_export->option('overlimit_groups'));
+ $old->usergroup( $groups );
+ $error ||= $part_export->export_replace($self, $old);
+ }
+ }
+
+ if ( $conf->exists("svc_acct-usage_unsuspend")) {
+ $error ||= $self->cust_svc->cust_pkg->unsuspend;
+ }
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error unsuspending: $error";
+ }
+ }
+
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+
+=item recharge HASHREF
+
+ Increments usage columns by the amount specified in HASHREF as
+ column=>amount pairs.
+
+=cut
+
+sub recharge {
+ my ($self, $vhash) = @_;
+
+ if ( $DEBUG ) {
+ warn "[$me] recharge called on $self: ". Dumper($self).
+ "\nwith vhash: ". Dumper($vhash);
+ }
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $error = '';
+
+ foreach my $column (keys %$vhash){
+ $error ||= $self->_op_usage('+', $column, $vhash->{$column});
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ }else{
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ }
+ return $error;
+}
+
+=item is_rechargeable
+
+Returns true if this svc_account can be "recharged" and false otherwise.
+
+=cut
+
+sub is_rechargable {
+ my $self = shift;
+ $self->seconds ne ''
+ || $self->upbytes ne ''
+ || $self->downbytes ne ''
+ || $self->totalbytes ne '';
+}
+
projects / freeside.git / blobdiff