},
{ 'key' => 'referral_credit',
- 'section' => 'billing',
- 'description' => "Enables one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency).",
+ 'section' => 'deprecated',
+ 'description' => "Used to enable one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency). Replace with a billing event on appropriate packages.",
'type' => 'checkbox',
},
{
'key' => 'referral_credit_type',
- 'section' => 'billing',
- 'description' => 'The group to use for new, automatically generated credit reasons resulting from referrals.',
+ 'section' => 'deprecated',
+ 'description' => 'Used to be the group to use for new, automatically generated credit reasons resulting from referrals. Now set in a package billing event for the referral.',
'type' => 'select-sub',
'options_sub' => sub { require FS::Record;
require FS::reason_type;
'otaker', 'varchar', '', 32, '', '',
'reason', 'text', 'NULL', '', '', '',
'reasonnum', 'int', 'NULL', '', '', '',
+ 'addlinfo', 'text', 'NULL', '', '', '',
'closed', 'char', 'NULL', 1, '', '',
],
'primary_key' => 'crednum',
Reason (see L<FS::reason>)
+=item addlinfo
+
+Text
+
=item closed
Books closed flag, empty or `Y'
|| $self->ut_alpha('otaker')
|| $self->ut_textn('reason')
|| $self->ut_foreign_key('reasonnum', 'reason', 'reasonnum')
+ || $self->ut_textn('addlinfo')
|| $self->ut_enum('closed', [ '', 'Y' ])
;
return $error if $error;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- $reason ? $reason->reason : '';
+ ( $reason ? $reason->reason : '' ).
+ ( $self->addlinfo ? ' '.$self->addlinfo : '' );
}
# _upgrade_data
die $error;
}
- my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
+ my $unapplied = $self->total_unapplied_credits
+ + $self->total_unapplied_payments
+ + $self->in_transit_payments;
foreach my $cust_bill ($self->open_cust_bill) {
#$dbh->commit or die $dbh->errstr if $oldAutoCommit;
my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
'';
}
-=item total_owed
-
-Returns the total owed for this customer on all invoices
-(see L<FS::cust_bill/owed>).
-
-=cut
-
-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 (
- grep { $_->_date <= $time }
- qsearch('cust_bill', { 'custnum' => $self->custnum, } )
- ) {
- $total_bill += $cust_bill->owed;
- }
- sprintf( "%.2f", $total_bill );
-}
-
=item apply_payments_and_credits
Applies unapplied payments and credits.
$self->select_for_update; #mutex
- unless ( $self->total_credited ) {
+ unless ( $self->total_unapplied_credits ) {
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return 0;
}
}
- my $total_credited = $self->total_credited;
+ my $total_unapplied_credits = $self->total_unapplied_credits;
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
- return $total_credited;
+ return $total_unapplied_credits;
}
=item apply_payments
#return 0 unless
- my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
- qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
+ my @payments = sort { $b->_date <=> $a->_date }
+ grep { $_->unapplied > 0 }
+ $self->cust_pay;
- my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
- qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
+ my @invoices = sort { $a->_date <=> $b->_date}
+ grep { $_->owed > 0 }
+ $self->cust_bill;
my $payment;
return $total_unapplied_payments;
}
-=item total_credited
+=item total_owed
+
+Returns the total owed for this customer on all invoices
+(see L<FS::cust_bill/owed>).
+
+=cut
+
+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 (
+ grep { $_->_date <= $time }
+ qsearch('cust_bill', { 'custnum' => $self->custnum, } )
+ ) {
+ $total_bill += $cust_bill->owed;
+ }
+ sprintf( "%.2f", $total_bill );
+}
+
+=item total_paid
+
+Returns the total amount of all payments.
+
+=cut
+
+sub total_paid {
+ my $self = shift;
+ my $total = 0;
+ $total += $_->paid foreach $self->cust_pay;
+ sprintf( "%.2f", $total );
+}
+
+=item total_unapplied_credits
Returns the total outstanding credit (see L<FS::cust_credit>) for this
customer. See L<FS::cust_credit/credited>.
+=item total_credited
+
+Old name for total_unapplied_credits. Don't use.
+
=cut
sub total_credited {
+ #carp "total_credited deprecated, use total_unapplied_credits";
+ shift->total_unapplied_credits(@_);
+}
+
+sub total_unapplied_credits {
my $self = shift;
my $total_credit = 0;
- foreach my $cust_credit ( qsearch('cust_credit', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_credit += $cust_credit->credited;
- }
+ $total_credit += $_->credited foreach $self->cust_credit;
sprintf( "%.2f", $total_credit );
}
sub total_unapplied_payments {
my $self = shift;
my $total_unapplied = 0;
- foreach my $cust_pay ( qsearch('cust_pay', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_unapplied += $cust_pay->unapplied;
- }
+ $total_unapplied += $_->unapplied foreach $self->cust_pay;
sprintf( "%.2f", $total_unapplied );
}
sub total_unapplied_refunds {
my $self = shift;
my $total_unapplied = 0;
- foreach my $cust_refund ( qsearch('cust_refund', {
- 'custnum' => $self->custnum,
- } ) ) {
- $total_unapplied += $cust_refund->unapplied;
- }
+ $total_unapplied += $_->unapplied foreach $self->cust_refund;
sprintf( "%.2f", $total_unapplied );
}
=item balance
Returns the balance for this customer (total_owed plus total_unrefunded, minus
-total_credited minus total_unapplied_payments).
+total_unapplied_credits minus total_unapplied_payments).
=cut
sprintf( "%.2f",
$self->total_owed
+ $self->total_unapplied_refunds
- - $self->total_credited
+ - $self->total_unapplied_credits
- $self->total_unapplied_payments
);
}
sprintf( "%.2f",
$self->total_owed_date($time)
+ $self->total_unapplied_refunds
- - $self->total_credited
+ - $self->total_unapplied_credits
- $self->total_unapplied_payments
);
}
qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
}
-=item credit AMOUNT, REASON
+=item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
Applies a credit to this customer. If there is an error, returns the error,
otherwise returns false.
+REASON can be a text string, an FS::reason object, or a scalar reference to
+a reasonnum. If a text string, it will be automatically inserted as a new
+reason, and a 'reason_type' option must be passed to indicate the
+FS::reason_type for the new reason.
+
+An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
+
+Any other options are passed to FS::cust_credit::insert.
+
=cut
sub credit {
my( $self, $amount, $reason, %options ) = @_;
+
my $cust_credit = new FS::cust_credit {
'custnum' => $self->custnum,
'amount' => $amount,
- 'reason' => $reason,
};
+
+ if ( ref($reason) ) {
+
+ if ( ref($reason) eq 'SCALAR' ) {
+ $cust_credit->reasonnum( $$reason );
+ } else {
+ $cust_credit->reasonnum( $reason->reasonnum );
+ }
+
+ } else {
+ $cust_credit->set('reason', $reason)
+ }
+
+ $cust_credit->addlinfo( delete $options{'addlinfo'} )
+ if exists($options{'addlinfo'});
+
$cust_credit->insert(%options);
+
}
=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
Returns an SQL fragment to retreive the balance for this customer, only
considering invoices with date earlier than START_TIME, and optionally not
-later than END_TIME (total_owed_date minus total_credited minus
+later than END_TIME (total_owed_date minus total_unapplied_credits minus
total_unapplied_payments).
Times are specified as SQL fragments or numeric
=over 4
-=item pkgnum - primary key (assigned automatically for new billing items)
+=item pkgnum
-=item custnum - Customer (see L<FS::cust_main>)
+primary key (assigned automatically for new billing items)
-=item pkgpart - Billing item definition (see L<FS::part_pkg>)
+=item custnum
-=item setup - date
+Customer (see L<FS::cust_main>)
-=item bill - date (next bill date)
+=item pkgpart
+
+Billing item definition (see L<FS::part_pkg>)
-=item last_bill - last bill date
+=item setup
-=item adjourn - date
+date
-=item susp - date
+=item bill
-=item expire - date
+date (next bill date)
-=item cancel - date
+=item last_bill
-=item otaker - order taker (assigned automatically if null, see L<FS::UID>)
+last bill date
-=item manual_flag - If this field is set to 1, disables the automatic
-unsuspension of this package when using the B<unsuspendauto> config file.
+=item adjourn
-=item quantity - If not set, defaults to 1
+date
+
+=item susp
+
+date
+
+=item expire
+
+date
+
+=item cancel
+
+date
+
+=item otaker
+
+order taker (assigned automatically if null, see L<FS::UID>)
+
+=item manual_flag
+
+If this field is set to 1, disables the automatic
+unsuspension of this package when using the B<unsuspendauto> config option.
+
+=item quantity
+
+If not set, defaults to 1
+
+=item change_date
+
+Date of change from previous package
+
+=item change_pkgnum
+
+Previous pkgnum
+
+=item change_pkgpart
+
+Previous pkgpart
=back
-Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
-see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
-conversion functions.
+Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
+are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
+L<Time::Local> and L<Date::Parse> for conversion functions.
=head1 METHODS
#}
my $conf = new FS::Conf;
- my $cust_main = $self->cust_main;
- my $part_pkg = $self->part_pkg;
- if ( $conf->exists('referral_credit')
- && $cust_main->referral_custnum
- && ! $options{'change'}
- && $part_pkg->freq !~ /^0\D?$/
- )
- {
- my $referring_cust_main = $cust_main->referring_cust_main;
- if ( $referring_cust_main->status ne 'cancelled' ) {
- my $error;
- if ( $part_pkg->freq !~ /^\d+$/ ) {
- warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
- ' for package '. $self->pkgnum.
- ' ( customer '. $self->custnum. ')'.
- ' - One-time referral credits not (yet) available for '.
- ' packages with '. $part_pkg->freq_pretty. ' frequency';
- } else {
-
- my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
- my $error =
- $referring_cust_main->
- credit( $amount,
- 'Referral credit for '.$cust_main->name,
- 'reason_type' => $conf->config('referral_credit_type')
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error crediting customer ". $cust_main->referral_custnum.
- " for referral: $error";
- }
-
- }
-
- }
- }
if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
my $queue = new FS::queue {
=cut
sub eventtable_pkey_sql {
- #my $class = shift;
+ my $class = shift;
- my %hash = (
- 'cust_main' => 'cust_main.custnum',
- 'cust_bill' => 'cust_bill.invnum',
- 'cust_pkg' => 'cust_pkg.pkgnum',
- 'cust_pay_batch' => 'cust_pay_batch.paybatchnum',
- );
+ my $hashref = $class->eventtable_pkey;
+
+ my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
\%hash;
}
+=item eventtable_pkey
+
+Returns a hash reference of full SQL primary key names for eventtable values,
+i.e. 'cust_main'=>'custnum'
+
+=cut
+
+sub eventtable_pkey {
+ #my $class = shift;
+
+ {
+ 'cust_main' => 'custnum',
+ 'cust_bill' => 'invnum',
+ 'cust_pkg' => 'pkgnum',
+ 'cust_pay_batch' => 'paybatchnum',
+ };
+}
=item eventtables
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Add postal invoicing';
-}
+sub description { 'Add postal invoicing'; }
-sub default_weight {
- 20;
-}
+sub default_weight { 20; }
sub do_action {
my( $self, $cust_object ) = @_;
'Apply unapplied payments and credits';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
-sub default_weight {
- 70;
-}
+sub default_weight { 70; }
sub do_action {
my( $self, $cust_object ) = @_;
'Generate invoices (normally only used with a Late Fee event)';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
-sub default_weight {
- 60;
-}
+sub default_weight { 60; }
sub do_action {
my( $self, $cust_object ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Cancel';
-}
+sub description { 'Cancel'; }
sub option_fields {
(
'reason_class' => 'C',
},
);
-
-};
-
-sub default_weight {
- 20;
}
+sub default_weight { 20; }
+
sub do_action {
my( $self, $cust_object ) = @_;
'Collect on invoices (normally only used with a Late Fee and Generate Invoice events)';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
-sub default_weight {
- 80;
-}
+sub default_weight { 80; }
sub do_action {
my( $self, $cust_object ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Add card or check to a pending batch';
-}
+sub description { 'Add card or check to a pending batch'; }
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 40;
-}
+sub default_weight { 40; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Pay invoice with a complimentary "payment"';
-}
+sub description { 'Pay invoice with a complimentary "payment"'; }
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 30;
-}
+sub default_weight { 30; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Late fee (percentage of invoice)';
-}
+sub description { 'Late fee (percentage of invoice)'; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
);
}
-sub default_weight {
- 10;
-}
+sub default_weight { 10; }
sub do_action {
my( $self, $cust_bill ) = @_;
'Run card with a Business::OnlinePayment realtime gateway';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 30;
-}
+sub default_weight { 30; }
sub do_action {
my( $self, $cust_bill ) = @_;
'Run check with a Business::OnlinePayment realtime gateway';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 30;
-}
+sub default_weight { 30; }
sub do_action {
my( $self, $cust_bill ) = @_;
'Run phone bill ("LEC") billing with a Business::OnlinePayment realtime gateway';
}
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 30;
-}
+sub default_weight { 30; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Send invoice (email/print/fax)';
-}
+sub description { 'Send invoice (email/print/fax)'; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
);
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Send invoice (email/print/fax) with alternate template';
-}
+sub description { 'Send invoice (email/print/fax) with alternate template'; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
);
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Upload CSV invoice data to an FTP server';
-}
+sub description { 'Upload CSV invoice data to an FTP server'; }
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
);
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
);
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Spool CSV invoice data';
-}
+sub description { 'Spool CSV invoice data'; }
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
);
}
-sub default_weight {
- 50;
-}
+sub default_weight { 50; }
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Suspend if balance (this invoice and previous) over';
-}
+sub description { 'Suspend if balance (this invoice and previous) over'; }
-sub deprecated {
- 1;
-}
+sub deprecated { 1; }
sub eventtable_hashref {
{ 'cust_bill' => 1 };
'reason_class' => 'S',
},
);
-};
-
-sub default_weight {
- 10;
}
+sub default_weight { 10; }
+
sub do_action {
my( $self, $cust_bill ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Late fee (flat)';
-}
+sub description { 'Late fee (flat)'; }
sub option_fields {
(
'charge' => { label=>'Amount', type=>'money', }, # size=>7, },
'reason' => 'Reason',
);
-};
-
-sub default_weight {
- 10;
}
+sub default_weight { 10; }
+
sub do_action {
my( $self, $cust_object ) = @_;
--- /dev/null
+package FS::part_event::Action::pkg_referral_credit;
+
+use strict;
+use base qw( FS::part_event::Action );
+
+sub description { 'Credit the referring customer a specific amount'; }
+
+sub eventtable_hashref {
+ { 'cust_pkg' => 1 };
+}
+
+sub option_fields {
+ (
+ 'reasonnum' => { 'label' => 'Credit reason',
+ 'type' => 'select-reason',
+ 'reason_class' => 'R',
+ },
+ 'amount' => { 'label' => 'Credit amount',
+ 'type' => 'money',
+ },
+ );
+
+}
+
+#a little false laziness w/pkg_referral_credit_pkg
+sub do_action {
+ my( $self, $cust_pkg ) = @_;
+
+ my $cust_main = $self->cust_main($cust_pkg);
+
+# my $part_pkg = $cust_pkg->part_pkg;
+
+ return 'No referring customer' unless $cust_main->referral_custnum;
+
+ my $referring_cust_main = $cust_main->referring_cust_main;
+ return 'Referring customer is cancelled'
+ if $referring_cust_main->status eq 'cancelled';
+
+ my $amount = $self->_calc_referral_credit($cust_pkg);
+ my $reasonnum = $self->option('reasonnum');
+
+ my $error = $referring_cust_main->credit(
+ $amount,
+ \$reasonnum,
+ 'addlinfo' =>
+ 'for customer #'. $cust_main->display_custnum. ': '.$cust_main->name,
+ );
+ die "Error crediting customer ". $cust_main->referral_custnum.
+ " for referral: $error"
+ if $error;
+
+}
+
+sub _calc_referral_credit {
+ my( $self, $cust_pkg ) = @_;
+
+ $self->option('amount');
+}
+
+1;
--- /dev/null
+package FS::part_event::Action::pkg_referral_credit_pkg;
+
+use strict;
+use base qw( FS::part_event::Action::pkg_referral_credit );
+
+sub description { 'Credit the referring customer an amount based on the referred package'; }
+
+#sub eventtable_hashref {
+# { 'cust_pkg' => 1 };
+#}
+
+sub option_fields {
+ (
+ 'reasonnum' => { 'label' => 'Credit reason',
+ 'type' => 'select-reason',
+ 'reason_class' => 'R',
+ },
+ 'percent' => { 'label' => 'Percent',
+ 'type' => 'input-percentage',
+ 'default' => '100',
+ },
+ 'what' => { 'label' => 'Of',
+ 'type' => 'select',
+ #also add some way to specify in the package def, no?
+ 'options' => [ qw( base_recur_permonth ) ],
+ 'labels' => { 'base_recur_permonth' => 'Base monthly fee', },
+ },
+ );
+
+}
+
+sub _calc_referral_credit {
+ my( $self, $cust_pkg ) = @_;
+
+ my $cust_main = $self->cust_main($cust_pkg);
+
+ my $part_pkg = $cust_pkg->part_pkg;
+
+ my $what = $self->option('what');
+
+ if ( $what eq 'base_recur_permonth' ) { #huh. yuck.
+ if ( $part_pkg->freq !~ /^\d+$/ ) {
+ die 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
+ ' for package '. $cust_pkg->pkgnum.
+ ' ( customer '. $cust_pkg->custnum. ')'.
+ ' - Referral credits not (yet) available for '.
+ ' packages with '. $part_pkg->freq_pretty. ' frequency';
+ }
+ }
+
+ my $percent = $self->option('percent');
+
+ sprintf('%.2f', $part_pkg->$what($cust_pkg) * $percent / 100 );
+
+}
+
+1;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Suspend';
-}
+sub description { 'Suspend'; }
sub option_fields {
(
'reason_class' => 'S',
},
);
-};
-
-sub default_weight {
- 10;
}
+sub default_weight { 10; }
+
sub do_action {
my( $self, $cust_object ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Suspend packages';
-}
+sub description { 'Suspend packages'; }
+
+#i should be deprecated in favor of using the if_pkgpart condition
sub option_fields {
(
'reason_class' => 'S',
},
);
-};
-
-sub default_weight {
- 10;
}
+sub default_weight { 10; }
+
sub do_action {
my( $self, $cust_object ) = @_;
use strict;
use base qw( FS::part_event::Action );
-sub description {
- 'Suspend packages except';
-}
+sub description { 'Suspend packages except'; }
+
+#i should be deprecated in favor of using the unless_pkgpart condition
sub option_fields {
(
'reason_class' => 'S',
},
);
-};
-
-sub default_weight {
- 10;
}
+sub default_weight { 10; }
+
sub do_action {
my( $self, $cust_object ) = @_;
use strict;
use base qw( FS::part_event_condition );
-
+use Time::Local qw(timelocal_nocheck);
use FS::UID qw( driver_name );
=head1 NAME
=back
+=item option_age_from OPTION FROM_TIMESTAMP
+
+Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
+"12m"), and subtracts that interval from the supplied timestamp. It is
+primarily intended for use in B<condition>.
+
+=cut
+
+sub option_age_from {
+ my( $self, $option, $time ) = @_;
+ my $age = $self->option($option);
+ $age = '0m' unless length($age);
+
+ my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
+
+ if ( $age =~ /^(\d+)m$/i ) {
+ $mon -= $1;
+ until ( $mon >= 0 ) { $mon += 12; $year--; }
+ } elsif ( $age =~ /^(\d+)y$/i ) {
+ $year -= $1;
+ } elsif ( $age =~ /^(\d+)w$/i ) {
+ $mday -= $1 * 7;
+ } elsif ( $age =~ /^(\d+)d$/i ) {
+ $mday -= $1;
+ } elsif ( $age =~ /^(\d+)h$/i ) {
+ $hour -= $hour;
+ } else {
+ die "unparsable age: $age";
+ }
+
+ timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
+
+}
+
=item condition_sql_option OPTION
This is a class method that returns an SQL fragment for retreiving a condition
my $balance_sql = FS::cust_main->balance_sql;
- "$balance_sql > $over";
+ "$balance_sql > CAST( $over AS numeric )";
}
package FS::part_event::Condition::balance_age;
-require 5.006;
use strict;
-use Time::Local qw(timelocal_nocheck);
-
use base qw( FS::part_event::Condition );
sub description { 'Customer balance age'; }
my $over = $self->option('balance');
$over = 0 unless length($over);
- #false laziness w/cust_bill_age
- my $time = $opt{'time'};
- my $age = $self->option('age');
- $age = '0m' unless length($age);
-
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
- if ( $age =~ /^(\d+)m$/i ) {
- $mon -= $1;
- until ( $mon >= 0 ) { $mon += 12; $year--; }
- } elsif ( $age =~ /^(\d+)y$/i ) {
- $year -= $1;
- } elsif ( $age =~ /^(\d+)w$/i ) {
- $mday -= $1 * 7;
- } elsif ( $age =~ /^(\d+)d$/i ) {
- $mday -= $1;
- } elsif ( $age =~ /^(\d+)h$/i ) {
- $hour -= $hour;
- } else {
- die "unparsable age: $age";
- }
- my $age_date = timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
-
- $cust_main->balance_date($age_date) > $over;
+ my $age = $self->option_age_from('age', $opt{'time'} );
+
+ $cust_main->balance_date($age) > $over;
}
sub condition_sql {
my $balance_sql = FS::cust_main->balance_date_sql( $age );
- "$balance_sql > $over";
+ "$balance_sql > CAST( $over AS numeric )";
}
sub order_sql {
my $balance_sql = FS::cust_main->balance_sql;
- "$balance_sql <= $under";
+ "$balance_sql <= CAST( $under AS numeric )";
}
package FS::part_event::Condition::cust_bill_age;
-require 5.006;
use strict;
-use Time::Local qw(timelocal_nocheck);
-
use base qw( FS::part_event::Condition );
-sub description {
- 'Invoice age';
-}
+sub description { 'Invoice age'; }
sub eventtable_hashref {
{ 'cust_main' => 0,
};
}
-#something like this
sub option_fields {
(
- #'days' => { label=>'Days', size=>3, },
'age' => { label=>'Age', type=>'freq', },
);
}
sub condition {
my( $self, $cust_bill, %opt ) = @_;
- #false laziness w/balance_age
- my $time = $opt{'time'};
- my $age = $self->option('age');
- $age = '0m' unless length($age);
+ my $age = $self->option_age_from('age', $opt{'time'} );
- my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
- if ( $age =~ /^(\d+)m$/i ) {
- $mon -= $1;
- until ( $mon >= 0 ) { $mon += 12; $year--; }
- } elsif ( $age =~ /^(\d+)y$/i ) {
- $year -= $1;
- } elsif ( $age =~ /^(\d+)w$/i ) {
- $mday -= $1 * 7;
- } elsif ( $age =~ /^(\d+)d$/i ) {
- $mday -= $1;
- } elsif ( $age =~ /^(\d+)h$/i ) {
- $hour -= $hour;
- } else {
- die "unparsable age: $age";
- }
- my $age_date = timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
-
- $cust_bill->_date <= $age_date;
+ $cust_bill->_date <= $age;
}
-# and seconds <= $time - cust_bill._date
-
sub condition_sql {
my( $class, $table, %opt ) = @_;
FROM cust_bill_pkg cbp, cust_svc cs
WHERE cbp.invnum = cust_bill.invnum
AND cs.pkgnum = cbp.pkgnum
- AND cs.svcpart = $servicenum
+ AND cs.svcpart = CAST( $servicenum AS integer )
)
|;
return $sql;
my $owed_sql = FS::cust_bill->owed_sql;
- "$owed_sql > $over";
+ "$owed_sql > CAST( $over AS numeric )";
}
1;
my $owed_sql = FS::cust_bill->owed_sql;
- "$owed_sql <= $under";
+ "$owed_sql <= CAST( $under AS numeric )";
}
1;
--- /dev/null
+package FS::part_event::Condition::cust_payments;
+
+use strict;
+use base qw( FS::part_event::Condition );
+
+sub description { 'Customer total payments'; }
+
+sub option_fields {
+ (
+ 'over' => { 'label' => 'Customer total payments at least',
+ 'type' => 'money',
+ 'value' => '0.00', #default
+ },
+ );
+}
+
+sub condition {
+ my($self, $object) = @_;
+
+ my $cust_main = $self->cust_main($object);
+
+ my $over = $self->option('over');
+ $over = 0 unless length($over);
+
+ $cust_main->total_paid >= $over;
+
+}
+
+#XXX add for efficiency. could use cust_main::total_paid_sql
+#use FS::cust_main;
+#sub condition_sql {
+# my( $class, $table ) = @_;
+#
+# my $over = $class->condition_sql_option('balance');
+#
+# my $balance_sql = FS::cust_main->balance_sql;
+#
+# "$balance_sql > $over";
+#
+#}
+
+1;
+
--- /dev/null
+package FS::part_event::Condition::has_referral_custnum;
+
+use strict;
+use FS::cust_main;
+
+use base qw( FS::part_event::Condition );
+
+sub description { 'Customer has a referring customer'; }
+
+sub condition {
+ my($self, $object) = @_;
+
+ my $cust_main = $self->cust_main($object);
+
+ $cust_main->referral_custnum;
+}
+
+sub condition_sql {
+ #my( $class, $table ) = @_;
+
+ "cust_main.referral_custnum IS NOT NULL";
+}
+
+1;
--- /dev/null
+package FS::part_event::Condition::once_percust;
+
+use strict;
+use FS::Record qw( qsearch );
+use FS::part_event;
+use FS::cust_event;
+
+use base qw( FS::part_event::Condition );
+
+sub description { "Don't run more than once per customer"; }
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 1,
+ 'cust_pkg' => 1,
+ };
+}
+
+sub condition {
+ my($self, $object, %opt) = @_;
+
+ my $obj_pkey = $object->primary_key;
+ my $obj_table = $object->table;
+ my $custnum = $object->custnum;
+
+ my @where = (
+ "tablenum IN ( SELECT $obj_pkey FROM $obj_table WHERE custnum = $custnum )"
+ );
+ if ( $opt{'cust_event'}->eventnum =~ /^(\d+)$/ ) {
+ push @where, " eventnum != $1 ";
+ }
+ my $extra_sql = ' AND '. join(' AND ', @where);
+
+ my @existing = qsearch( {
+ 'table' => 'cust_event',
+ 'hashref' => {
+ 'eventpart' => $self->eventpart,
+ #'tablenum' => $tablenum,
+ 'status' => { op=>'!=', value=>'failed' },
+ },
+ 'extra_sql' => $extra_sql,
+ } );
+
+ ! scalar(@existing);
+
+}
+
+#XXX test?
+sub condition_sql {
+ my( $self, $table ) = @_;
+
+ my %pkey = %{ FS::part_event->eventtable_pkey };
+
+ my $pkey = $pkey{$table};
+
+ "0 = ( SELECT COUNT(*) FROM cust_event
+ WHERE cust_event.eventpart = part_event.eventpart
+ AND cust_event.tablenum IN (
+ SELECT $pkey FROM $table AS once_percust
+ WHERE once_percust.custnum = cust_main.custnum )
+ AND status != 'failed'
+ )
+ ";
+
+}
+
+1;
--- /dev/null
+package FS::part_event::Condition::pkg_age;
+
+use strict;
+use base qw( FS::part_event::Condition );
+use FS::Record qw( qsearch );
+
+sub description {
+ 'Package Age';
+}
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 0,
+ 'cust_pkg' => 1,
+ };
+}
+
+#something like this
+sub option_fields {
+ (
+ 'age' => { 'label' => 'Package date age',
+ 'type' => 'freq',
+ },
+ 'field' => { 'label' => 'Compare date',
+ 'type' => 'select',
+ 'options' =>
+ [qw( setup last_bill bill adjourn susp expire cancel )],
+ 'labels' => {
+ 'setup' => 'Setup date',
+ 'last_bill' => 'Last bill date',
+ 'bill' => 'Next bill date',
+ 'adjourn' => 'Adjournment date',
+ 'susp' => 'Suspension date',
+ 'expire' => 'Expiration date',
+ 'cancel' => 'Cancellation date',
+ },
+ },
+ );
+}
+
+sub condition {
+ my( $self, $cust_pkg, %opt ) = @_;
+
+ my $age = $self->option_age_from('age', $opt{'time'} );
+
+ my $pkg_date = $cust_pkg->get( $self->option('field') );
+
+ $pkg_date && $pkg_date <= $age;
+
+}
+
+#XXX write me for efficiency
+#sub condition_sql {
+#
+#}
+
+1;
+
--- /dev/null
+package FS::part_event::Condition::pkg_notchange;
+
+use strict;
+
+use base qw( FS::part_event::Condition );
+use FS::Record qw( qsearch );
+
+sub description {
+ 'Package is a new order, not a change';
+}
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 0,
+ 'cust_pkg' => 1,
+ };
+}
+
+sub condition {
+ my( $self, $cust_pkg ) = @_;
+
+ ! $cust_pkg->change_date;
+
+}
+
+sub condition_sql {
+ '( cust_pkg.change_date IS NULL OR cust_pkg.change_date = 0 )';
+}
+
+1;
+
--- /dev/null
+package FS::part_event::Condition::pkg_pkgpart;
+
+use strict;
+
+use base qw( FS::part_event::Condition );
+
+sub description { 'Package definitions'; }
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 0,
+ 'cust_pkg' => 1,
+ };
+}
+
+sub option_fields {
+ (
+ 'if_pkgpart' => { 'label' => 'Only packages: ',
+ 'type' => 'select-part_pkg',
+ 'multiple' => 1,
+ },
+ );
+}
+
+sub condition {
+ my( $self, $cust_pkg) = @_;
+
+ #XXX test
+ my $if_pkgpart = $self->option('if_pkgpart') || {};
+ $if_pkgpart->{ $cust_pkg->pkgpart };
+
+}
+
+#XXX
+#sub condition_sql {
+#
+#}
+
+1;
--- /dev/null
+package FS::part_event::Condition::pkg_recurring;
+
+use strict;
+
+use base qw( FS::part_event::Condition );
+
+sub description { 'Package is recurring'; }
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 0,
+ 'cust_pkg' => 1,
+ };
+}
+
+sub condition {
+ my( $self, $cust_pkg ) = @_;
+
+ $cust_pkg->part_pkg->freq !~ /^0+\D?$/; #just in case, probably just != '0'
+
+}
+
+
+#XXX join part_pkg USING (pkgpart)
+# part_pkg.freq != '0'
+#sub condition_sql {
+#
+#}
+
+1;
+
--- /dev/null
+package FS::part_event::Condition::pkg_unless_pkgpart;
+
+use strict;
+
+use base qw( FS::part_event::Condition );
+
+sub description { 'Except package definitions'; }
+
+sub eventtable_hashref {
+ { 'cust_main' => 0,
+ 'cust_bill' => 0,
+ 'cust_pkg' => 1,
+ };
+}
+
+sub option_fields {
+ (
+ 'unless_pkgpart' => { 'label' => 'Except packages: ',
+ 'type' => 'select-part_pkg',
+ 'multiple' => 1,
+ },
+ );
+}
+
+sub condition {
+ my( $self, $cust_pkg) = @_;
+
+ #XXX test
+ my $unless_pkgpart = $self->option('unless_pkgpart') || {};
+ ! $unless_pkgpart->{ $cust_pkg->pkgpart };
+
+}
+
+#XXX
+#sub condition_sql {
+#
+#}
+
+1;
$self->option('recur_fee', 1) || 0;
}
+sub base_recur_permonth {
+ my($self, $cust_pkg) = @_; #$cust_pkg?
+
+ return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
+
+ sprintf('%.2f', $self->base_recur / $self->freq );
+}
+
sub calc_remain {
my ($self, $cust_pkg, %options) = @_;
projects / freeside.git / commitdiff