my $statement = "SELECT $select FROM $table";
if ( @fields ) {
- $statement .= " WHERE ". join(' AND ', map {
+ $statement .= ' WHERE '. join(' AND ', map {
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( driver_name eq 'Pg' ) {
"$_ IS NULL";
$statement .= " $extra_sql" if defined($extra_sql);
warn $statement if $DEBUG;
- my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr;
+ my $sth = $dbh->prepare_cached($statement)
+ or croak "$dbh->errstr doing $statement";
$sth->execute( map $record->{$_},
grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
) or croak $dbh->errstr;
+ $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
}
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
undef $self; #no need to keep object!
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
=head1 VERSION
-$Id: Record.pm,v 1.11 2000-12-06 10:21:13 ivan Exp $
+$Id: Record.pm,v 1.12 2001-02-03 14:03:49 ivan Exp $
=head1 BUGS
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
$conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
+ $AutoCommit
);
use subs qw(
getsecrets cgisetotaker
$conf_dir = "/usr/local/etc/freeside/";
+$AutoCommit = 1; #ours, not DBI
+
=head1 NAME
FS::UID - Subroutines for database login and assorted other stuff
croak "Not running uid freeside!" unless checkeuid();
getsecrets;
$dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- 'AutoCommit' => 'true',
+ 'AutoCommit' => 'false',
'ChopBlanks' => 'true',
} ) or die "DBI->connect error: $DBI::errstr\n";
=head1 VERSION
-$Id: UID.pm,v 1.3 2000-06-23 12:25:59 ivan Exp $
+$Id: UID.pm,v 1.4 2001-02-03 14:03:49 ivan Exp $
=head1 BUGS
use Mail::Internet;
use Mail::Header;
use Business::CreditCard;
-use FS::UID qw( getotaker );
+use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch );
use FS::cust_pkg;
use FS::cust_bill;
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
+There is a special insert mode in which you pass a data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects. When
+running under a transactional database, all records are inserted atomicly, or
+the transaction is rolled back. There should be a better explanation of this,
+but until then, here's an example:
+
+ use Tie::RefHash;
+ tie %hash, 'Tie::RefHash'; #this part is important
+ %hash = {
+ $cust_pkg => [ $svc_acct ],
+ };
+ $cust_main->insert( \%hash );
+
=cut
sub insert {
my $self = shift;
- my $flag = 0;
- if ( $self->payby eq 'PREPAY' ) {
- $self->payby('BILL');
- $flag = 1;
- }
-
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- my $error = $self->SUPER::insert;
- return $error if $error;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
- if ( $flag ) {
- my $prepay_credit =
- qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+ my $amount = 0;
+ my $seconds = 0;
+ if ( $self->payby eq 'PREPAY' ) {
+ $self->payby('BILL');
+ my $prepay_credit = qsearchs(
+ 'prepay_credit',
+ { 'identifier' => $self->payinfo },
+ '',
+ 'FOR UPDATE'
+ );
warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
unless $prepay_credit;
- my $amount = $prepay_credit->amount;
+ $amount = $prepay_credit->amount;
+ $seconds = $prepay_credit->seconds;
my $error = $prepay_credit->delete;
if ( $error ) {
- warn "WARNING: can't delete prepay_credit: ". $self->payinfo;
- } else {
- my $cust_credit = new FS::cust_credit {
- 'custnum' => $self->custnum,
- 'amount' => $amount,
- };
- my $error = $cust_credit->insert;
- warn "WARNING: error inserting cust_credit for prepay_credit: $error"
- if $error;
+ $dbh->rollback;
+ return $error;
+ }
+ }
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+
+ if ( @_ ) {
+ my $cust_pkgs = shift;
+ foreach my $cust_pkg ( keys %$cust_pkgs ) {
+ $cust_pkg->custnum( $self->custnum );
+ $error = $cust_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+ foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+ $svc_something->pkgnum( $cust_pkg->pkgnum );
+ if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
+ $svc_something->seconds( $svc_something->seconds + $seconds );
+ $seconds = 0;
+ }
+ $error = $svc_something->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+ }
}
+ }
+
+ if ( $seconds ) {
+ $dbh->rollback;
+ return "No svc_acct record to apply pre-paid time";
+ }
+ if ( $amount ) {
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ };
+ $error = $cust_credit->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
}
+ $dbh->commit or die $dbh->errstr;
'';
}
=head1 VERSION
-$Id: cust_main.pm,v 1.9 2001-01-31 07:21:00 ivan Exp $
+$Id: cust_main.pm,v 1.10 2001-02-03 14:03:50 ivan Exp $
=head1 BUGS
#!/usr/bin/perl -Tw
#
-# $Id: fs-setup,v 1.32 2000-12-04 00:13:02 ivan Exp $
+# $Id: fs-setup,v 1.33 2001-02-03 14:03:50 ivan Exp $
#
# ivan@sisd.com 97-nov-8,9
#
# fix radius attributes ivan@sisd.com 98-sep-27
#
# $Log: fs-setup,v $
-# Revision 1.32 2000-12-04 00:13:02 ivan
+# Revision 1.33 2001-02-03 14:03:50 ivan
+# time-based prepaid cards, session monitor. woop!
+#
+# Revision 1.32 2000/12/04 00:13:02 ivan
# fix nas.last type
#
# Revision 1.31 2000/12/01 18:34:53 ivan
'shell', 'varchar', 'NULL', $char_d,
'quota', 'varchar', 'NULL', $char_d,
'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
+ 'seconds', 'int', 'NULL', '', #uhhhh
],
'primary_key' => 'svcnum',
'unique' => [ [] ],
'prepaynum', 'int', '', '',
'identifier', 'varchar', '', $char_d,
'amount', @money_type,
+ 'seconds', 'int', 'NULL', '',
],
'primary_key' => 'prepaynum',
'unique' => [ ['identifier'] ],
my $amount = shift or die &usage;
+my $seconds = shift or die &usage;
+
my $num_digits = shift or die &usage;
my $num_entries = shift or die &usage;
my $prepay_credit = new FS::prepay_credit {
'identifier' => $identifier,
'amount' => $amount,
+ 'seconds' => $seconds,
};
my $error = $prepay_credit->insert;
die $error if $error;
}
sub usage {
- die "Usage:\n\n generate-prepay user amount num_digits num_entries";
+ die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries";
}
use vars qw( $opt $Debug );
use IO::Handle;
use Net::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup dbh);
use FS::Record qw( qsearchs ); #qsearch );
#use FS::cust_main_county;
#use FS::cust_main;
return "Incorrect password"
if exists($href->{'password'})
&& $href->{'password'} ne $svc_acct->_password;
+ return "Time limit exceeded" unless $svc_acct->seconds;
my $session = new FS::session {
'portnum' => $href->{'portnum'},
'svcnum' => $svc_acct->svcnum,
my $href = shift;
$href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username";
my $username = $1;
- my $svc_acct = qsearchs('svc_acct', { 'username' => $username } )
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $svc_acct =
+ qsearchs('svc_acct', { 'username' => $username }, '', 'FOR UPDATE' )
or return "Unknown user";
return "Incorrect password"
if exists($href->{'password'})
&& $href->{'password'} ne $svc_acct->_password;
my $session = qsearchs( 'session', {
- 'portnum' => $href->{'portnum'},
- 'svcnum' => $svc_acct->svcnum,
- 'logout' => '',
- } );
- return "No currently open sessions found for that user/port!" unless $session;
+ 'portnum' => $href->{'portnum'},
+ 'svcnum' => $svc_acct->svcnum,
+ 'logout' => '',
+ },
+ '', 'FOR UPDATE'
+ );
+ unless ( $session ) {
+ $dbh->rollback;
+ return "No currently open sessions found for that user/port!";
+ }
my $nsession = new FS::session ( { $session->hash } );
warn "$nsession replacing $session";
- $nsession->replace($session);
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ return "can't logout: $error";
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time: $error\n"; #don't want to rollback, though
+ $dbh->commit or die $dbh->errstr;
+ ''
}
sub usage {
use strict;
use IO::Handle;
+use Tie::RefHash;
use FS::SSH qw(sshopen2);
use FS::UID qw(adminsuidsetup);
use FS::Record qw( qsearch qsearchs );
$error ||= $svc_acct->check;
- $error ||= $cust_main->insert;
- if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $cust_pkg->custnum( $cust_main->custnum );
- $error ||= $cust_pkg->insert;
- warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
- $svc_acct->pkgnum( $cust_pkg->pkgnum );
- $error ||= $svc_acct->insert;
- warn "WARNING: $error on pre-checked svc_acct record!" if $error;
- }
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash';
+ %hash = { $cust_pkg => [ $svc_acct ] };
+ $error ||= $cust_main->insert( \%hash );
+ #if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always
+ # #be definied, but....
+ # $cust_pkg->custnum( $cust_main->custnum );
+ # $error ||= $cust_pkg->insert;
+ # warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
+ # $svc_acct->pkgnum( $cust_pkg->pkgnum );
+ # $error ||= $svc_acct->insert;
+ # warn "WARNING: $error on pre-checked svc_acct record!" if $error;
+ #}
warn "[fs_signup_server] Sending results...\n" if $Debug;
print $writer $error, "\n";
<li>Sesstion start - The command(s) specified in the <a href="config.html#session-start">session-start</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
<li>Session end - The command(s) specified in the <a href="config.html#session-stop">session-stop</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
</ul>
+<h2>Dropping expired users</h2>
+Run <pre>bin/freeside-session-kill username</pre> periodically from cron.
</body>
</html>
<li>$email_name - first and last name
</ul>
(an example file is included as <b>fs_signup/cck.template</b>). See the <a href="http://help.netscape.com/products/client/mc/acctproc4.html">Netscape documentation</a> for more information.
- <li>If there are any entries in the <i>prepay_credit</i> table, a user can enter a string matching the <b>identifier</i> column to receive the credit specified in the <b>amount</b> column, after which that <b>identifier</b> is no longer valid. This can be used to implement pre-paid "calling card" type signups. The <i>bin/generate-prepay</i> script can be used to populate the <i>prepay_credit</i> table.
+ <li>If there are any entries in the <i>prepay_credit</i> table, a user can enter a string matching the <b>identifier</i> column to receive the credit specified in the <b>amount</b> column, and/or the time specified in the <b>seconds</b> column (for use with the <a href="session.html">session monitor</a>), after which that <b>identifier</b> is no longer valid. This can be used to implement pre-paid "calling card" type signups. The <i>bin/generate-prepay</i> script can be used to populate the <i>prepay_credit</i> table.
</ul>
</body>
ALTER TABLE part_svc ADD svc_www__usersvc varchar(80) NULL;
ALTER TABLE part_svc ADD svc_www__uesrsvc_flag char(1) NULL;
ALTER TABLE svc_acct CHANGE _password _password varchar(50) NULL;
+ALTER TABLE svc_acct ADD seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
+ALTER TABLE prepay_credit ADD seconds integer NULL;
</pre>
<li>Copy or symlink htdocs to the new copy.
projects / freeside.git / commitdiff