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
}
}
}
- my @cancelled_pkgs = $self->all_pkgs;
+ my @cancelled_cust_pkg = $self->all_pkgs;
foreach my $cust_pkg ( @cancelled_cust_pkg ) {
my $error = $cust_pkg->delete;
if ( $error ) {
$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
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)
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.43 2001-10-22 08:29:42 ivan Exp $
+$Id: cust_main.pm,v 1.52 2001-12-28 14:40:35 ivan Exp $
=head1 BUGS
projects / freeside.git / blobdiff