use strict;
use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
$smtpmachine $Debug $bop_processor $bop_login $bop_password
- $bop_action @bop_options);
+ $bop_action @bop_options $import );
use Safe;
use Carp;
use Time::Local;
use FS::cust_bill_pay;
use FS::prepay_credit;
use FS::queue;
+use FS::part_pkg;
@ISA = qw( FS::Record );
$Debug = 0;
#$Debug = 1;
+$import = 0;
+
#ask FS::UID to run this stuff for us later
$FS::UID::callback{'FS::cust_main'} = sub {
$conf = new FS::Conf;
}
};
+sub _cache {
+ my $self = shift;
+ my ( $hashref, $cache ) = @_;
+ if ( exists $hashref->{'pkgnum'} ) {
+# #@{ $self->{'_pkgnum'} } = ();
+ my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
+ $self->{'_pkgnum'} = $subcache;
+ #push @{ $self->{'_pkgnum'} },
+ FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
+ }
+}
+
=head1 NAME
FS::cust_main - Object methods for cust_main records
what you want when a customer cancels service; for that, cancel all of the
customer's packages (see L<FS::cust_pkg/cancel>).
-If the customer has any packages, you need to pass a new (valid) customer
-number for those packages to be transferred to.
+If the customer has any uncancelled packages, you need to pass a new (valid)
+customer number for those packages to be transferred to. Cancelled packages
+will be deleted. Did I mention that this is NOT what you want when a customer
+cancels service and that you really should be looking see L<FS::cust_pkg/cancel>?
You can't delete a customer with invoices (see L<FS::cust_bill>),
-or credits (see L<FS::cust_credit>).
+or credits (see L<FS::cust_credit>) or payments (see L<FS::cust_pay>).
=cut
$dbh->rollback if $oldAutoCommit;
return "Can't delete a customer with credits";
}
+ if ( qsearch( 'cust_pay', { 'custnum' => $self->custnum } ) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Can't delete a customer with payments";
+ }
- my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
+ my @cust_pkg = $self->ncancelled_pkgs;
if ( @cust_pkg ) {
my $new_custnum = shift;
unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
}
}
}
+ my @cancelled_cust_pkg = $self->all_pkgs;
+ foreach my $cust_pkg ( @cancelled_cust_pkg ) {
+ my $error = $cust_pkg->delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+ }
+
foreach my $cust_main_invoice (
qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
) {
$self->ss("$1-$2-$3");
}
- unless ( qsearchs('cust_main_county', {
- 'country' => $self->country,
- 'state' => '',
- } ) ) {
- return "Unknown state/county/country: ".
- $self->state. "/". $self->county. "/". $self->country
- unless qsearchs('cust_main_county',{
- 'state' => $self->state,
- 'county' => $self->county,
- 'country' => $self->country,
- } );
+ unless ( $import ) {
+ unless ( qsearchs('cust_main_county', {
+ 'country' => $self->country,
+ 'state' => '',
+ } ) ) {
+ return "Unknown state/county/country: ".
+ $self->state. "/". $self->county. "/". $self->country
+ unless qsearchs('cust_main_county',{
+ 'state' => $self->state,
+ 'county' => $self->county,
+ 'country' => $self->country,
+ } );
+ }
}
$error =
sub all_pkgs {
my $self = shift;
- qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ if ( $self->{'_pkgnum'} ) {
+ values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
+ }
}
=item ncancelled_pkgs
sub ncancelled_pkgs {
my $self = shift;
- @{ [ # force list context
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => '',
- }),
- qsearch( 'cust_pkg', {
- 'custnum' => $self->custnum,
- 'cancel' => 0,
- }),
- ] };
+ if ( $self->{'_pkgnum'} ) {
+ grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache };
+ } else {
+ @{ [ # force list context
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => '',
+ }),
+ qsearch( 'cust_pkg', {
+ 'custnum' => $self->custnum,
+ 'cancel' => 0,
+ }),
+ ] };
+ }
}
=item suspended_pkgs
# & generate invoice database.
my( $total_setup, $total_recur ) = ( 0, 0 );
+ my( $taxable_setup, $taxable_recur ) = ( 0, 0 );
my @cust_bill_pkg = ();
foreach my $cust_pkg (
- qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
+ qsearch('cust_pkg', { 'custnum' => $self->custnum } )
) {
+ #NO!! next if $cust_pkg->cancel;
next if $cust_pkg->getfield('cancel');
#? to avoid use of uninitialized value errors... ?
$setup = eval $setup_prog;
unless ( defined($setup) ) {
$dbh->rollback if $oldAutoCommit;
- return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
- ": $@";
+ return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart.
+ "(expression $setup_prog): $@";
}
$cust_pkg->setfield('setup',$time);
$cust_pkg_mod_flag=1;
$recur = eval $recur_prog;
unless ( defined($recur) ) {
$dbh->rollback if $oldAutoCommit;
- return "Error reval-ing part_pkg->recur pkgpart ".
- $part_pkg->pkgpart. ": $@";
+ return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart.
+ "(expression $recur_prog): $@";
}
#change this bit to use Date::Manip? CAREFUL with timezones (see
# mailing list archive)
push @cust_bill_pkg, $cust_bill_pkg;
$total_setup += $setup;
$total_recur += $recur;
+ $taxable_setup += $setup
+ unless $part_pkg->dbdef_table->column('setuptax')
+ || $part_pkg->setuptax =~ /^Y$/i;
+ $taxable_recur += $recur
+ unless $part_pkg->dbdef_table->column('recurtax')
+ || $part_pkg->recurtax =~ /^Y$/i;
}
}
}
my $charged = sprintf( "%.2f", $total_setup + $total_recur );
+ my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur );
unless ( @cust_bill_pkg ) {
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '';
}
- unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) {
+ unless ( $self->tax =~ /Y/i
+ || $self->payby eq 'COMP'
+ || $taxable_charged == 0 ) {
my $cust_main_county = qsearchs('cust_main_county',{
'state' => $self->state,
'county' => $self->county,
'country' => $self->country,
} );
my $tax = sprintf( "%.2f",
- $charged * ( $cust_main_county->getfield('tax') / 100 )
+ $taxable_charged * ( $cust_main_county->getfield('tax') / 100 )
);
- $charged = sprintf( "%.2f", $charged+$tax );
-
- my $cust_bill_pkg = new FS::cust_bill_pkg ({
- 'pkgnum' => 0,
- 'setup' => $tax,
- 'recur' => 0,
- 'sdate' => '',
- 'edate' => '',
- });
- push @cust_bill_pkg, $cust_bill_pkg;
+
+ if ( $tax > 0 ) {
+ $charged = sprintf( "%.2f", $charged+$tax );
+
+ my $cust_bill_pkg = new FS::cust_bill_pkg ({
+ 'pkgnum' => 0,
+ 'setup' => $tax,
+ 'recur' => 0,
+ 'sdate' => '',
+ 'edate' => '',
+ });
+ push @cust_bill_pkg, $cust_bill_pkg;
+ }
}
my $cust_bill = new FS::cust_bill ( {
my $invnum = $cust_bill->invnum;
my $cust_bill_pkg;
foreach $cust_bill_pkg ( @cust_bill_pkg ) {
- warn $cust_bill_pkg->invnum($invnum);
+ #warn $invnum;
+ $cust_bill_pkg->invnum($invnum);
$error = $cust_bill_pkg->insert;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
sub total_owed {
my $self = shift;
+ $self->total_owed_date(2145859200); #12/31/2037
+}
+
+=item total_owed_date TIME
+
+Returns the total owed for this customer on all invoices with date earlier than
+TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
+see L<Time::Local> and L<Date::Parse> for conversion functions.
+
+=cut
+
+sub total_owed_date {
+ my $self = shift;
+ my $time = shift;
my $total_bill = 0;
- foreach my $cust_bill ( qsearch('cust_bill', {
- 'custnum' => $self->custnum,
- } ) ) {
+ foreach my $cust_bill (
+ grep { $_->_date <= $time }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
$total_bill += $cust_bill->owed;
}
sprintf( "%.2f", $total_bill );
);
}
+=item balance_date TIME
+
+Returns the balance for this customer, only considering invoices with date
+earlier than TIME (total_owed_date minus total_credited minus
+total_unapplied_payments). TIME is specified as a UNIX timestamp; see
+L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+=cut
+
+sub balance_date {
+ my $self = shift;
+ my $time = shift;
+ sprintf( "%.2f",
+ $self->total_owed_date($time)
+ - $self->total_credited
+ - $self->total_unapplied_payments
+ );
+}
+
=item invoicing_list [ ARRAYREF ]
If an arguement is given, sets these email addresses as invoice recipients
$cust_credit->insert;
}
+=item charge AMOUNT PKG COMMENT
+
+Creates a one-time charge for this customer. If there is an error, returns
+the error, otherwise returns false.
+
+=cut
+
+sub charge {
+ my ( $self, $amount, $pkg, $comment ) = @_;
+
+ my $part_pkg = new FS::part_pkg ( {
+ 'pkg' => $pkg || 'One-time charge',
+ 'comment' => $comment,
+ 'setup' => $amount,
+ 'freq' => 0,
+ 'recur' => '0',
+ 'disabled' => 'Y',
+ } );
+
+ $part_pkg->insert;
+
+}
+
=back
=head1 SUBROUTINES
=head1 VERSION
-$Id: cust_main.pm,v 1.41 2001-10-15 12:16:42 ivan Exp $
+$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $
=head1 BUGS
projects / freeside.git / blobdiff