diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/AccessRight.pm | 1 | ||||
| -rw-r--r-- | FS/FS/ClientAPI/MyAccount.pm | 18 | ||||
| -rw-r--r-- | FS/FS/Conf.pm | 47 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 9 | ||||
| -rw-r--r-- | FS/FS/UI/Web.pm | 11 | ||||
| -rw-r--r-- | FS/FS/cust_main.pm | 81 | ||||
| -rw-r--r-- | FS/FS/part_export/sqlradius.pm | 45 | ||||
| -rw-r--r-- | FS/FS/svc_acct.pm | 250 |
8 files changed, 417 insertions, 45 deletions
diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm index 5370e2281..8ba78d5b1 100644 --- a/FS/FS/AccessRight.pm +++ b/FS/FS/AccessRight.pm @@ -115,6 +115,7 @@ assigned to users and/or groups. # customer service rights ### 'Provision customer service', + 'Recharge customer service', 'Unprovision customer service', 'View/link unlinked services', #not agent-virtualizable without more work diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 16b207132..eb49a6d00 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -8,6 +8,7 @@ use Date::Format; use Business::CreditCard; use Time::Duration; use FS::CGI qw(small_custview); #doh +use FS::UI::Web; use FS::Conf; use FS::Record qw(qsearch qsearchs); use FS::Msgcat qw(gettext); @@ -378,10 +379,12 @@ sub process_prepay { my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) or return { 'error' => "unknown custnum $custnum" }; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes ) = ( 0, 0, 0, 0 ); my $error = $cust_main->recharge_prepay( $p->{'prepaid_cardnum'}, \$amount, - \$seconds + \$seconds, + \$upbytes, + \$downbytes ); return { 'error' => $error } if $error; @@ -390,6 +393,10 @@ sub process_prepay { 'amount' => $amount, 'seconds' => $seconds, 'duration' => duration_exact($seconds), + 'upbytes' => $upbytes, + 'upload' => FS::UI::Web::bytecount_unexact($upbytes), + 'downbytes'=> $downbytes, + 'download' => FS::UI::Web::bytecount_unexact($downbytes), }; } @@ -539,7 +546,9 @@ sub list_svcs { my @cust_svc = (); #foreach my $cust_pkg ( $cust_main->ncancelled_pkgs ) { - foreach my $cust_pkg ( $cust_main->unsuspended_pkgs ) { + foreach my $cust_pkg ( $p->{'ncancelled'} + ? $cust_main->ncancelled_pkgs + : $cust_main->unsuspended_pkgs ) { push @cust_svc, @{[ $cust_pkg->cust_svc ]}; #@{[ ]} to force array context } @cust_svc = grep { $_->part_svc->svcdb eq $p->{'svcdb'} } @cust_svc @@ -560,6 +569,9 @@ sub list_svcs { 'value' => $value, 'username' => $svc_x->username, 'email' => $svc_x->email, + 'seconds' => $svc_x->seconds, + 'upbytes' => $svc_x->upbytes, + 'downbytes'=> $svc_x->downbytes, # more... }; } diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index bf853bc19..639f06baa 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1419,6 +1419,42 @@ httemplate/docs/config.html }, { + 'key' => 'warning_email', + 'section' => '', + 'description' => 'Template file for warning email. Warning emails are sent to the customer email invoice destination(s) each time a svc_acct record has its usage drop below a threshold or 0. See the <a href="http://search.cpan.org/~mjd/Text-Template/lib/Text/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available<ul><li><code>$username</code> <li><code>$password</code> <li><code>$first</code> <li><code>$last</code> <li><code>$pkg</code> <li><code>$column</code> <li><code>$amount</code> <li><code>$threshold</code></ul>', + 'type' => 'textarea', + }, + + { + 'key' => 'warning_email-from', + 'section' => '', + 'description' => 'From: address header for warning email', + 'type' => 'text', + }, + + { + 'key' => 'warning_email-cc', + 'section' => '', + 'description' => 'Additional recipient(s) (comma separated) for warning email when remaining usage reaches zero.', + 'type' => 'text', + }, + + { + 'key' => 'warning_email-subject', + 'section' => '', + 'description' => 'Subject: header for warning email', + 'type' => 'text', + }, + + { + 'key' => 'warning_email-mimetype', + 'section' => '', + 'description' => 'MIME type for warning email', + 'type' => 'select', + 'select_enum' => [ 'text/plain', 'text/html' ], + }, + + { 'key' => 'payby', 'section' => 'billing', 'description' => 'Available payment types.', @@ -1715,18 +1751,25 @@ httemplate/docs/config.html { 'key' => 'svc_acct-usage_suspend', 'section' => 'billing', - 'description' => 'Suspends the package an account belongs to when svc_acct.seconds is decremented to 0 or below (accounts with an empty seconds value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', + 'description' => 'Suspends the package an account belongs to when svc_acct.seconds or a bytecount is decremented to 0 or below (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', 'type' => 'checkbox', }, { 'key' => 'svc_acct-usage_unsuspend', 'section' => 'billing', - 'description' => 'Unuspends the package an account belongs to when svc_acct.seconds is incremented from 0 or below to a positive value (accounts with an empty seconds value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', + 'description' => 'Unuspends the package an account belongs to when svc_acct.seconds or a bytecount is incremented from 0 or below to a positive value (accounts with an empty seconds and up|down|totalbytes value are ignored). Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd.', 'type' => 'checkbox', }, { + 'key' => 'svc_acct-usage_threshold', + 'section' => 'billing', + 'description' => 'The threshold (expressed as percentage) of acct.seconds or acct.up|down|totalbytes at which a warning message is sent to a service holder. Typically used in conjunction with prepaid packages and freeside-sqlradius-radacctd. Defaults to 80.', + 'type' => 'text', + }, + + { 'key' => 'cust-fields', 'section' => 'UI', 'description' => 'Which customer fields to display on reports by default', diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 99f88735a..400ef0646 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -837,6 +837,13 @@ sub tables_hashref { 'quota', 'varchar', 'NULL', $char_d, '', '', 'slipip', 'varchar', 'NULL', 15, '', '', #four TINYINTs, bah. 'seconds', 'int', 'NULL', '', '', '', #uhhhh + 'seconds_threshold', 'int', 'NULL', '', '', '', + 'upbytes', 'int', 'NULL', '', '', '', + 'upbytes_threshold', 'int', 'NULL', '', '', '', + 'downbytes', 'int', 'NULL', '', '', '', + 'downbytes_threshold', 'int', 'NULL', '', '', '', + 'totalbytes','int', 'NULL', '', '', '', + 'totalbytes_threshold', 'int', 'NULL', '', '', '', 'domsvc', 'int', '', '', '', '', ], 'primary_key' => 'svcnum', @@ -923,6 +930,8 @@ sub tables_hashref { 'identifier', 'varchar', '', $char_d, '', '', 'amount', @money_type, '', '', 'seconds', 'int', 'NULL', '', '', '', + 'upbytes', 'int', 'NULL', '', '', '', + 'downbytes', 'int', 'NULL', '', '', '', 'agentnum', 'int', 'NULL', '', '', '', ], 'primary_key' => 'prepaynum', diff --git a/FS/FS/UI/Web.pm b/FS/FS/UI/Web.pm index c9eaf5012..0597a385e 100644 --- a/FS/FS/UI/Web.pm +++ b/FS/FS/UI/Web.pm @@ -64,6 +64,17 @@ sub parse_lt_gt { } +sub bytecount_unexact { + my $bc = shift; + return("$bc bytes") + if ($bc < 1000); + return(sprintf("%.2f Kbytes", $bc/1000)) + if ($bc < 1000000); + return(sprintf("%.2f Mbytes", $bc/1000000)) + if ($bc < 1000000000); + return(sprintf("%.2f Gbytes", $bc/1000000000)); +} + ### # cust_main report subroutines ### diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index e4ab84d55..210ab63c9 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -692,21 +692,23 @@ sub order_pkgs { ''; #no error } -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] Recharges this (existing) customer with the specified prepaid card (see L<FS::prepay_credit>), specified either by I<identifier> or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. -Optionally, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid +Optionally, four scalar references can be passed as well. They will have their +values filled in with the amount, number of seconds, and number of upload and +download bytes applied by this prepaid card. =cut sub recharge_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -719,10 +721,14 @@ sub recharge_prepay { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes ) = ( 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + my $error = $self->get_prepay($prepay_credit, \$amount, + \$seconds, \$upbytes, \$downbytes) || $self->increment_seconds($seconds) + || $self->increment_upbytes($upbytes) + || $self->increment_downbytes($downbytes) + || $self->increment_totalbytes($upbytes + $downbytes) || $self->insert_cust_pay_prepay( $amount, ref($prepay_credit) ? $prepay_credit->identifier @@ -736,6 +742,8 @@ sub recharge_prepay { if ( defined($amountref) ) { $$amountref = $amount; } if ( defined($secondsref) ) { $$secondsref = $seconds; } + if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } + if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -759,7 +767,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, $upref, $downref) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -806,12 +814,50 @@ sub get_prepay { $$amountref += $prepay_credit->amount; $$secondsref += $prepay_credit->seconds; + $$upref += $prepay_credit->upbytes; + $$downref += $prepay_credit->downbytes; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } +=item increment_upbytes SECONDS + +Updates this customer's single or primary account (see L<FS::svc_acct>) by +the specified number of upbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_upbytes { + _increment_column( shift, 'upbytes', @_); +} + +=item increment_downbytes SECONDS + +Updates this customer's single or primary account (see L<FS::svc_acct>) by +the specified number of downbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_downbytes { + _increment_column( shift, 'downbytes', @_); +} + +=item increment_totalbytes SECONDS + +Updates this customer's single or primary account (see L<FS::svc_acct>) by +the specified number of totalbytes. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_totalbytes { + _increment_column( shift, 'totalbytes', @_); +} + =item increment_seconds SECONDS Updates this customer's single or primary account (see L<FS::svc_acct>) by @@ -821,10 +867,24 @@ otherwise returns false. =cut sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" + _increment_column( shift, 'seconds', @_); +} + +=item _increment_column AMOUNT + +Updates this customer's single or primary account (see L<FS::svc_acct>) by +the specified number of seconds or bytes. If there is an error, returns +the error, otherwise returns false. + +=cut + +sub _increment_column { + my( $self, $column, $amount ) = @_; + warn "$me increment_column called: $column, $amount\n" if $DEBUG; + return '' unless $amount; + my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } $self->ncancelled_pkgs; @@ -854,7 +914,8 @@ sub increment_seconds { ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; - $svc_acct->increment_seconds($seconds); + $column = "increment_$column"; + $svc_acct->$column($amount); } diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 04d65126d..dadd236e7 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -615,7 +615,8 @@ sub update_svc_acct { my $where = ''; my $sth = $dbh->prepare(" - SELECT RadAcctId, UserName, Realm, AcctSessionTime + SELECT RadAcctId, UserName, Realm, AcctSessionTime, + AcctInputOctets, AcctOutputOctets FROM radacct WHERE FreesideStatus IS NULL AND AcctStopTime != 0 @@ -623,7 +624,8 @@ sub update_svc_acct { $sth->execute() or die $sth->errstr; while ( my $row = $sth->fetchrow_arrayref ) { - my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row; + my($RadAcctId, $UserName, $Realm, $AcctSessionTime, + $AcctInputOctets, $AcctOutputOctets) = @$row; warn "processing record: ". "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s" if $DEBUG; @@ -633,7 +635,6 @@ sub update_svc_acct { if ( ref($self) =~ /withdomain/ ) { #well... $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain WHERE svc_domain.svcnum = svc_acct.domsvc ) "; - my $svc_domain = qsearch } my @svc_acct = @@ -654,18 +655,16 @@ sub update_svc_acct { } elsif ( scalar(@svc_acct) > 1 ) { warn "WARNING: multiple svc_acct records found $errinfo - skipping\n"; } else { - my $svc_acct = $svc_acct[0]; - warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG; - if ( $svc_acct->seconds !~ /^$/ ) { - warn " svc_acct.seconds found (". $svc_acct->seconds. - ") - decrementing\n" - if $DEBUG; - my $error = $svc_acct->decrement_seconds($AcctSessionTime); - die $error if $error; - $status = 'done'; - } else { - warn " no existing seconds value for svc_acct - skiping\n" if $DEBUG; - } + warn "found svc_acct ". $svc_acct[0]->svcnum. " $errinfo\n" if $DEBUG; + _try_decrement($svc_acct[0], 'seconds', $AcctSessionTime) + and $status='done'; + _try_decrement($svc_acct[0], 'upbytes', $AcctInputOctets) + and $status='done'; + _try_decrement($svc_acct[0], 'downbytes', $AcctOutputOctets) + and $status='done'; + _try_decrement($svc_acct[0], 'totalbytes', $AcctInputOctets + + $AcctOutputOctets) + and $status='done'; } warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; @@ -679,5 +678,21 @@ sub update_svc_acct { } +sub _try_decrement { + my ($svc_acct, $column, $amount) = @_; + if ( $svc_acct->$column !~ /^$/ ) { + warn " svc_acct.$column found (". $svc_acct->$column. + ") - decrementing\n" + if $DEBUG; + my $method = 'decrement_' . $column; + my $error = $svc_acct->$method($amount); + die $error if $error; + return 'done'; + } else { + warn " no existing $column value for svc_acct - skipping\n" if $DEBUG; + } + return ''; +} + 1; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 98564cce2..3db12f630 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -9,6 +9,8 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $username_uppercase $username_percent $password_noampersand $password_noexclamation $welcome_template $welcome_from $welcome_subject $welcome_mimetype + $warning_template $warning_from $warning_subject $warning_mimetype + $warning_cc $smtpmachine $radius_password $radius_ip $dirhash @@ -76,6 +78,22 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $welcome_subject = ''; $welcome_mimetype = ''; } + if ( $conf->exists('warning_email') ) { + $warning_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", $conf->config('warning_email') ] + ) or warn "can't create warning email template: $Text::Template::ERROR"; + $warning_from = $conf->config('warning_email-from'); # || 'your-isp-is-dum' + $warning_subject = $conf->config('warning_email-subject') || 'Warning'; + $warning_mimetype = $conf->config('warning_email-mimetype') || 'text/plain'; + $warning_cc = $conf->config('warning_email-cc'); + } else { + $warning_template = ''; + $warning_from = ''; + $warning_subject = ''; + $warning_mimetype = ''; + $warning_cc = ''; + } $smtpmachine = $conf->config('smtpmachine'); $radius_password = $conf->config('radius-password') || 'Password'; $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; @@ -168,6 +186,12 @@ FS::svc_Common. The following fields are currently supported: =item seconds - +=item upbytes - + +=item downbytes - + +=item totalbytes - + =item domsvc - svcnum from svc_domain =item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply) @@ -721,6 +745,10 @@ sub check { #|| $self->ut_number('domsvc') || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) || $self->ut_textn('sec_phrase') + || $self->ut_snumbern('seconds') + || $self->ut_snumbern('upbytes') + || $self->ut_snumbern('downbytes') + || $self->ut_snumbern('totalbytes') ; return $error if $error; @@ -1215,6 +1243,72 @@ sub acct_snarf { qsearch('acct_snarf', { 'svcnum' => $self->svcnum } ); } +=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 @@ -1223,7 +1317,7 @@ is an error, returns the error, otherwise returns false. =cut sub decrement_seconds { - shift->_op_seconds('-', @_); + shift->_op_usage('-', 'seconds', @_); } =item increment_seconds SECONDS @@ -1234,7 +1328,7 @@ is an error, returns the error, otherwise returns false. =cut sub increment_seconds { - shift->_op_seconds('+', @_); + shift->_op_usage('+', 'seconds', @_); } @@ -1243,20 +1337,32 @@ my %op2action = ( '+' => 'unsuspend', ); my %op2condition = ( - '-' => sub { my($self, $seconds) = @_; - $self->seconds - $seconds <= 0; + '-' => sub { my($self, $column, $amount) = @_; + $self->$column - $amount <= 0; }, - '+' => sub { my($self, $seconds) = @_; - $self->seconds + $seconds > 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 ) = @_; -sub _op_seconds { - my( $self, $op, $seconds ) = @_; - warn "$me _op_seconds called for svcnum ". $self->svcnum. - ' ('. $self->email. "): $op $seconds\n" + 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'; @@ -1268,24 +1374,24 @@ sub _op_seconds { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $sql = "UPDATE svc_acct SET seconds = ". - " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0 + 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($seconds, $self->svcnum); + my $rv = $sth->execute($amount, $self->svcnum); die "Error executing $sql: ". $sth->errstr unless defined($rv); - die "Can't update seconds for svcnum". $self->svcnum + die "Can't update $column for svcnum". $self->svcnum if $rv == 0; my $action = $op2action{$op}; if ( $conf->exists("svc_acct-usage_$action") - && &{$op2condition{$op}}($self, $seconds) ) { + && &{$op2condition{$op}}($self, $column, $amount) ) { #my $error = $self->$action(); my $error = $self->cust_svc->cust_pkg->$action(); if ( $error ) { @@ -1294,6 +1400,30 @@ sub _op_seconds { } } + 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; @@ -1302,6 +1432,20 @@ sub _op_seconds { } +=item is_rechargeable + +Returns true if this svc_account can be "rechaged" and false otherwise. + +=cut + +sub is_rechargable { + my $self = shift; + $self->seconds ne '' + || $self->upbytes ne '' + || $self->downbytes ne '' + || $self->totalbytes ne ''; +} + =item seconds_since TIMESTAMP Returns the number of seconds this account has been online since TIMESTAMP, @@ -1785,6 +1929,82 @@ END $html; } +=item reached_threshold + +Performs some activities when svc_acct thresholds (such as number of seconds +remaining) are reached. + +=cut + +sub reached_threshold { + my %opt = @_; + + my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $opt{'svcnum'} } ); + die "Cannot find svc_acct with svcnum " . $opt{'svcnum'} unless $svc_acct; + + if ( $opt{'op'} eq '+' ){ + $svc_acct->setfield( $opt{'column'}.'_threshold', + int($svc_acct->getfield($opt{'column'}) + * ( $conf->exists('svc_acct-usage_threshold') + ? $conf->config('svc_acct-usage_threshold')/100 + : 0.80 + ) + ) + ); + my $error = $svc_acct->replace; + die $error if $error; + }elsif ( $opt{'op'} eq '-' ){ + + my $threshold = $svc_acct->getfield( $opt{'column'}.'_threshold' ); + return '' if ($threshold eq '' && opt{'column'} eq 'totalbytes'); + + $svc_acct->setfield( $opt{'column'}.'_threshold', 0 ); + my $error = $svc_acct->replace; + die $error if $error; # email next time, i guess + + if ( $warning_template ) { + eval "use FS::Misc qw(send_email)"; + die $@ if $@; + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + my $cust_main = $cust_pkg->cust_main; + + my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } + $cust_main->invoicing_list, + $svc_acct->email, + ($opt{'to'} ? $opt{'to'} : ()) + ); + + my $mimetype = $warning_mimetype; + $mimetype .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; + + my $body = $warning_template->fill_in( HASH => { + 'custnum' => $cust_main->custnum, + 'username' => $svc_acct->username, + 'password' => $svc_acct->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + 'column' => $opt{'column'}, + 'amount' => $svc_acct->getfield($opt{'column'}), + 'threshold' => $threshold, + } ); + + + my $error = send_email( + 'from' => $warning_from, + 'to' => $to, + 'subject' => $warning_subject, + 'content-type' => $mimetype, + 'body' => [ map "$_\n", split("\n", $body) ], + ); + die $error if $error; + } + }else{ + die "unknown op: " . $opt{'op'}; + } +} + =back =head1 BUGS |