diff options
Diffstat (limited to 'FS/FS')
-rw-r--r-- | FS/FS/Record.pm | 13 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 31 | ||||
-rw-r--r-- | FS/FS/cust_pay.pm | 12 | ||||
-rw-r--r-- | FS/FS/cust_pkg.pm | 28 | ||||
-rw-r--r-- | FS/FS/cust_svc.pm | 51 | ||||
-rw-r--r-- | FS/FS/svc_acct.pm | 35 |
6 files changed, 150 insertions, 20 deletions
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 6b7997f21..4286606f0 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -1,7 +1,8 @@ package FS::Record; use strict; -use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG); +use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG + $me ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); @@ -16,6 +17,7 @@ use FS::SearchCache; @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef jsearch); $DEBUG = 0; +$me = '[FS::Record]'; #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::Record'} = sub { @@ -225,7 +227,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); - warn $statement if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; @@ -474,6 +476,7 @@ sub insert { join(', ',map(_quote($self->getfield($_),$self->table,$_), @fields)). ")" ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -523,6 +526,7 @@ sub delete { ? ( $self->dbdef_table->primary_key) : $self->fields ); + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; @@ -561,11 +565,11 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); - warn "[debug][FS::Record] $new ->replace $old\n" if $DEBUG; + warn "[debug]$me $new ->replace $old\n" if $DEBUG; my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields; unless ( @diff ) { - carp "[warning][FS::Record] $new -> replace $old: records identical"; + carp "[warning]$me $new -> replace $old: records identical"; return ''; } @@ -596,6 +600,7 @@ sub replace { } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; + warn "[debug]$me $statement\n" if $DEBUG; my $sth = dbh->prepare($statement) or return dbh->errstr; local $SIG{HUP} = 'IGNORE'; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1a9d43e94..8a7a6f806 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -831,6 +831,18 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } +=item cancel + +Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer. +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub cancel { + my $self = shift; + grep { $_->cancel } $self->ncancelled_pkgs; +} + =item bill OPTIONS Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in @@ -1722,7 +1734,7 @@ sub check_invoicing_list { =item default_invoicing_list -Returns the email addresses of any +Sets the invoicing list to all accounts associated with this customer. =cut @@ -1740,6 +1752,21 @@ sub default_invoicing_list { $self->invoicing_list(\@list); } +=item invoicing_list_addpost + +Adds postal invoicing to this customer. If this customer is already configured +to receive postal invoices, does nothing. + +=cut + +sub invoicing_list_addpost { + my $self = shift; + return if grep { $_ eq 'POST' } $self->invoicing_list; + my @invoicing_list = $self->invoicing_list; + push @invoicing_list, 'POST'; + $self->invoicing_list(\@invoicing_list); +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -1966,7 +1993,7 @@ sub append_fuzzyfiles { =head1 VERSION -$Id: cust_main.pm,v 1.54 2002-01-09 13:29:33 ivan Exp $ +$Id: cust_main.pm,v 1.55 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 3f811357a..51c7b29e1 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -181,11 +181,17 @@ sub upgrade_replace { #1.3.x->1.4.x '_date' => $self->_date, }; $error = $cust_bill_pay->insert; - if ( $error ) { + if ( $error =~ + /total cust_bill_pay.amount and cust_credit_bill.amount .* for invnum .* greater than cust_bill.charged/ ) { + #warn $error; + my $cust_bill = qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); + $new->custnum($cust_bill->custnum); + } elsif ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; + } else { + $new->custnum($cust_bill_pay->cust_bill->custnum); } - $new->custnum($cust_bill_pay->cust_bill->custnum); } else { die; } @@ -312,7 +318,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.14 2002-01-28 06:57:23 ivan Exp $ +$Id: cust_pay.pm,v 1.15 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 633b3224f..b241ecac2 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -71,6 +71,8 @@ FS::cust_pkg - Object methods for cust_pkg objects @labels = $record->labels; + $seconds = $record->seconds_since($timestamp); + $error = FS::cust_pkg::order( $custnum, \@pkgparts ); $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] ); @@ -487,6 +489,30 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item seconds_since TIMESTAMP + +Returns the number of seconds all accounts (see L<FS::svc_acct>) in this +package have been online since TIMESTAMP. + +TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=cut + +sub seconds_since { + my($self, $since) = @_; + my $seconds = 0; + + foreach my $cust_svc ( + grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc + ) { + $seconds += $cust_svc->seconds_since($since); + } + + $seconds; + +} + =back =head1 SUBROUTINES @@ -630,7 +656,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.15 2002-01-21 11:30:17 ivan Exp $ +$Id: cust_pkg.pm,v 1.16 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 5fca892cd..541f0c801 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -3,7 +3,7 @@ package FS::cust_svc; use strict; use vars qw( @ISA ); use Carp qw( cluck ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; @@ -159,13 +159,8 @@ Returns a list consisting of: sub label { my $self = shift; my $svcdb = $self->part_svc->svcdb; - my $svc_x; - if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { - $svc_x = $self->{'_svc_acct'}; - } else { - $svc_x = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ) - or die "can't find $svcdb.svcnum ". $self->svcnum; - } + my $svc_x = $self->svc_x + or die "can't find $svcdb.svcnum ". $self->svcnum; my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; @@ -195,11 +190,49 @@ sub label { $self->part_svc->svc, $tag, $svcdb; } +=item svc_x + +Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or +FS::svc_domain object, etc.) + +=cut + +sub svc_x { + my $self = shift; + my $svcdb = $self->part_svc->svcdb; + if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { + $self->{'_svc_acct'}; + } else { + qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); + } +} + +=item seconds_since TIMESTAMP + +See L<FS::svc_acct/seconds_since>. Equivalent to +$cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records +where B<svcdb> is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +sub seconds_since { + my($self, $since) = @_; + my $dbh = dbh; + my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session + WHERE svcnum = ? + AND login >= ? + AND logout IS NOT NULL' + ) or die $dbh->errstr; + $sth->execute($self->svcnum, $since) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + =back =head1 VERSION -$Id: cust_svc.pm,v 1.8 2001-12-15 22:58:33 ivan Exp $ +$Id: cust_svc.pm,v 1.9 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 0340e7cc5..16270f9cc 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -134,6 +134,14 @@ FS::svc_acct - Object methods for svc_acct records %hash = $record->radius_check; + $domain = $record->domain; + + $svc_domain = $record->svc_domain; + + $email = $record->email; + + $seconds_since = $record->seconds_since($timestamp); + =head1 DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct inherits from @@ -990,6 +998,15 @@ sub svc_domain { : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); } +=item cust_svc + +Returns the FS::cust_svc record for this account (see L<FS::cust_svc>). + +sub cust_svc { + my $self = shift; + qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); +} + =item email Returns an email address associated with the account. @@ -1001,6 +1018,22 @@ sub email { $self->username. '@'. $self->domain; } +=item seconds_since TIMESTAMP + +Returns the number of seconds this account has been online since TIMESTAMP. +See L<FS::session> + +TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since { + my $self = shift; + $self->cust_svc->seconds_since(@_); +} + =item ssh =cut @@ -1033,7 +1066,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.63 2002-01-22 14:53:26 ivan Exp $ +$Id: svc_acct.pm,v 1.64 2002-01-29 16:33:15 ivan Exp $ =head1 BUGS |