diff options
Diffstat (limited to 'FS')
47 files changed, 752 insertions, 341 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index b86bfa8e6..b65b71943 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1823,8 +1823,8 @@ worry that config_items is freeside-specific and icky. }, { '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', }, @@ -2340,8 +2340,8 @@ worry that config_items is freeside-specific and icky. { '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; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 26900b085..73f4f264f 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -558,6 +558,7 @@ sub tables_hashref { 'otaker', 'varchar', '', 32, '', '', 'reason', 'text', 'NULL', '', '', '', 'reasonnum', 'int', 'NULL', '', '', '', + 'addlinfo', 'text', 'NULL', '', '', '', 'closed', 'char', 'NULL', 1, '', '', ], 'primary_key' => 'crednum', diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index d5b6ff465..99c63cb7f 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -87,6 +87,10 @@ Text ( deprecated ) Reason (see L<FS::reason>) +=item addlinfo + +Text + =item closed Books closed flag, empty or `Y' @@ -288,6 +292,7 @@ sub check { || $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; @@ -412,7 +417,8 @@ sub reason { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - $reason ? $reason->reason : ''; + ( $reason ? $reason->reason : '' ). + ( $self->addlinfo ? ' '.$self->addlinfo : '' ); } # _upgrade_data diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 5554f9f48..8b57b934c 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -4246,7 +4246,9 @@ sub batch_card { 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 { @@ -4273,39 +4275,6 @@ sub batch_card { ''; } -=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. @@ -4375,7 +4344,7 @@ sub apply_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; } @@ -4416,11 +4385,11 @@ sub apply_credits { } - 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 @@ -4452,11 +4421,13 @@ sub 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; @@ -4495,21 +4466,72 @@ sub apply_payments { 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 ); } @@ -4523,11 +4545,7 @@ See L<FS::cust_pay/unapplied>. 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 ); } @@ -4541,18 +4559,14 @@ customer. See L<FS::cust_refund/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 @@ -4561,7 +4575,7 @@ sub balance { sprintf( "%.2f", $self->total_owed + $self->total_unapplied_refunds - - $self->total_credited + - $self->total_unapplied_credits - $self->total_unapplied_payments ); } @@ -4582,7 +4596,7 @@ sub balance_date { sprintf( "%.2f", $self->total_owed_date($time) + $self->total_unapplied_refunds - - $self->total_credited + - $self->total_unapplied_credits - $self->total_unapplied_payments ); } @@ -4870,21 +4884,47 @@ sub referring_cust_main { 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 ] ] ] @@ -5474,7 +5514,7 @@ sub balance_sql { " 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 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 6d2c6018b..e359fc9fc 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -104,38 +104,76 @@ inherits from FS::Record. The following fields are currently supported: =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 @@ -223,42 +261,6 @@ sub insert { #} 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 { diff --git a/FS/FS/part_event.pm b/FS/FS/part_event.pm index d0ab65e3f..6f2c5366d 100644 --- a/FS/FS/part_event.pm +++ b/FS/FS/part_event.pm @@ -286,18 +286,32 @@ i.e. 'cust_main'=>'cust_main.custnum' =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 diff --git a/FS/FS/part_event/Action/addpost.pm b/FS/FS/part_event/Action/addpost.pm index e0e3fa878..f92e72ea0 100644 --- a/FS/FS/part_event/Action/addpost.pm +++ b/FS/FS/part_event/Action/addpost.pm @@ -3,13 +3,9 @@ package FS::part_event::Action::addpost; 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 ) = @_; diff --git a/FS/FS/part_event/Action/apply.pm b/FS/FS/part_event/Action/apply.pm index f91c6047e..823d1e0d3 100644 --- a/FS/FS/part_event/Action/apply.pm +++ b/FS/FS/part_event/Action/apply.pm @@ -7,13 +7,9 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/bill.pm b/FS/FS/part_event/Action/bill.pm index fec025f62..b96614d21 100644 --- a/FS/FS/part_event/Action/bill.pm +++ b/FS/FS/part_event/Action/bill.pm @@ -8,13 +8,9 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/cancel.pm b/FS/FS/part_event/Action/cancel.pm index 94f314602..b9d6d2996 100644 --- a/FS/FS/part_event/Action/cancel.pm +++ b/FS/FS/part_event/Action/cancel.pm @@ -3,9 +3,7 @@ package FS::part_event::Action::cancel; use strict; use base qw( FS::part_event::Action ); -sub description { - 'Cancel'; -} +sub description { 'Cancel'; } sub option_fields { ( @@ -14,13 +12,10 @@ sub option_fields { 'reason_class' => 'C', }, ); - -}; - -sub default_weight { - 20; } +sub default_weight { 20; } + sub do_action { my( $self, $cust_object ) = @_; diff --git a/FS/FS/part_event/Action/collect.pm b/FS/FS/part_event/Action/collect.pm index fa94b7def..98814404e 100644 --- a/FS/FS/part_event/Action/collect.pm +++ b/FS/FS/part_event/Action/collect.pm @@ -8,13 +8,9 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_batch.pm b/FS/FS/part_event/Action/cust_bill_batch.pm index aec09250b..50c306a45 100644 --- a/FS/FS/part_event/Action/cust_bill_batch.pm +++ b/FS/FS/part_event/Action/cust_bill_batch.pm @@ -3,21 +3,15 @@ package FS::part_event::Action::cust_bill_batch; 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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_comp.pm b/FS/FS/part_event/Action/cust_bill_comp.pm index 636a66df5..76fd27414 100644 --- a/FS/FS/part_event/Action/cust_bill_comp.pm +++ b/FS/FS/part_event/Action/cust_bill_comp.pm @@ -3,21 +3,15 @@ package FS::part_event::Action::cust_bill_comp; 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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_fee_percent.pm b/FS/FS/part_event/Action/cust_bill_fee_percent.pm index 100fc8bc3..570fd6316 100644 --- a/FS/FS/part_event/Action/cust_bill_fee_percent.pm +++ b/FS/FS/part_event/Action/cust_bill_fee_percent.pm @@ -3,9 +3,7 @@ package FS::part_event::Action::cust_bill_fee_percent; 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 }; @@ -18,9 +16,7 @@ sub option_fields { ); } -sub default_weight { - 10; -} +sub default_weight { 10; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_realtime_card.pm b/FS/FS/part_event/Action/cust_bill_realtime_card.pm index 471c946dc..c1fdba96a 100644 --- a/FS/FS/part_event/Action/cust_bill_realtime_card.pm +++ b/FS/FS/part_event/Action/cust_bill_realtime_card.pm @@ -8,17 +8,13 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_realtime_check.pm b/FS/FS/part_event/Action/cust_bill_realtime_check.pm index 9a52830ae..11b13a970 100644 --- a/FS/FS/part_event/Action/cust_bill_realtime_check.pm +++ b/FS/FS/part_event/Action/cust_bill_realtime_check.pm @@ -8,17 +8,13 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_realtime_lec.pm b/FS/FS/part_event/Action/cust_bill_realtime_lec.pm index db091dadb..cd03ddc3b 100644 --- a/FS/FS/part_event/Action/cust_bill_realtime_lec.pm +++ b/FS/FS/part_event/Action/cust_bill_realtime_lec.pm @@ -8,17 +8,13 @@ sub description { '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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_send.pm b/FS/FS/part_event/Action/cust_bill_send.pm index 9330c6113..663caf174 100644 --- a/FS/FS/part_event/Action/cust_bill_send.pm +++ b/FS/FS/part_event/Action/cust_bill_send.pm @@ -3,17 +3,13 @@ package FS::part_event::Action::cust_bill_send; 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 ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_send_agent.pm b/FS/FS/part_event/Action/cust_bill_send_agent.pm index fcf000736..670a32c5b 100644 --- a/FS/FS/part_event/Action/cust_bill_send_agent.pm +++ b/FS/FS/part_event/Action/cust_bill_send_agent.pm @@ -24,9 +24,7 @@ sub option_fields { ); } -sub default_weight { - 50; -} +sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_send_alternate.pm b/FS/FS/part_event/Action/cust_bill_send_alternate.pm index 6afb89a99..cfd9264d8 100644 --- a/FS/FS/part_event/Action/cust_bill_send_alternate.pm +++ b/FS/FS/part_event/Action/cust_bill_send_alternate.pm @@ -3,9 +3,7 @@ package FS::part_event::Action::cust_bill_send_alternate; 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 }; @@ -19,9 +17,7 @@ sub option_fields { ); } -sub default_weight { - 50; -} +sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm index db3554e01..bf472683f 100644 --- a/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm +++ b/FS/FS/part_event/Action/cust_bill_send_csv_ftp.pm @@ -3,13 +3,9 @@ package FS::part_event::Action::cust_bill_send_csv_ftp; 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 }; @@ -31,9 +27,7 @@ sub option_fields { ); } -sub default_weight { - 50; -} +sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_send_if_newest.pm b/FS/FS/part_event/Action/cust_bill_send_if_newest.pm index 916983ebe..083da8b08 100644 --- a/FS/FS/part_event/Action/cust_bill_send_if_newest.pm +++ b/FS/FS/part_event/Action/cust_bill_send_if_newest.pm @@ -24,9 +24,7 @@ sub option_fields { ); } -sub default_weight { - 50; -} +sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_spool_csv.pm b/FS/FS/part_event/Action/cust_bill_spool_csv.pm index 4300b6120..f20ee46c9 100644 --- a/FS/FS/part_event/Action/cust_bill_spool_csv.pm +++ b/FS/FS/part_event/Action/cust_bill_spool_csv.pm @@ -3,13 +3,9 @@ package FS::part_event::Action::cust_bill_spool_csv; 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 }; @@ -43,9 +39,7 @@ sub option_fields { ); } -sub default_weight { - 50; -} +sub default_weight { 50; } sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm b/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm index 655994963..13188ab7c 100644 --- a/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm +++ b/FS/FS/part_event/Action/cust_bill_suspend_if_balance.pm @@ -3,13 +3,9 @@ package FS::part_event::Action::cust_bill_suspend_if_balance; 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 }; @@ -23,12 +19,10 @@ sub option_fields { 'reason_class' => 'S', }, ); -}; - -sub default_weight { - 10; } +sub default_weight { 10; } + sub do_action { my( $self, $cust_bill ) = @_; diff --git a/FS/FS/part_event/Action/fee.pm b/FS/FS/part_event/Action/fee.pm index 81a84498a..3cf50fbca 100644 --- a/FS/FS/part_event/Action/fee.pm +++ b/FS/FS/part_event/Action/fee.pm @@ -3,21 +3,17 @@ package FS::part_event::Action::fee; 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 ) = @_; diff --git a/FS/FS/part_event/Action/pkg_referral_credit.pm b/FS/FS/part_event/Action/pkg_referral_credit.pm new file mode 100644 index 000000000..98d982066 --- /dev/null +++ b/FS/FS/part_event/Action/pkg_referral_credit.pm @@ -0,0 +1,60 @@ +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; diff --git a/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm new file mode 100644 index 000000000..08cf9a8fd --- /dev/null +++ b/FS/FS/part_event/Action/pkg_referral_credit_pkg.pm @@ -0,0 +1,57 @@ +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; diff --git a/FS/FS/part_event/Action/suspend.pm b/FS/FS/part_event/Action/suspend.pm index ec440ffd2..c77728e61 100644 --- a/FS/FS/part_event/Action/suspend.pm +++ b/FS/FS/part_event/Action/suspend.pm @@ -3,9 +3,7 @@ package FS::part_event::Action::suspend; use strict; use base qw( FS::part_event::Action ); -sub description { - 'Suspend'; -} +sub description { 'Suspend'; } sub option_fields { ( @@ -14,12 +12,10 @@ sub option_fields { 'reason_class' => 'S', }, ); -}; - -sub default_weight { - 10; } +sub default_weight { 10; } + sub do_action { my( $self, $cust_object ) = @_; diff --git a/FS/FS/part_event/Action/suspend_if_pkgpart.pm b/FS/FS/part_event/Action/suspend_if_pkgpart.pm index 9bdc9be53..6f2007c93 100644 --- a/FS/FS/part_event/Action/suspend_if_pkgpart.pm +++ b/FS/FS/part_event/Action/suspend_if_pkgpart.pm @@ -3,9 +3,9 @@ package FS::part_event::Action::suspend_if_pkgpart; 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 { ( @@ -18,12 +18,10 @@ sub option_fields { 'reason_class' => 'S', }, ); -}; - -sub default_weight { - 10; } +sub default_weight { 10; } + sub do_action { my( $self, $cust_object ) = @_; diff --git a/FS/FS/part_event/Action/suspend_unless_pkgpart.pm b/FS/FS/part_event/Action/suspend_unless_pkgpart.pm index f9bf1e860..efc7a2d00 100644 --- a/FS/FS/part_event/Action/suspend_unless_pkgpart.pm +++ b/FS/FS/part_event/Action/suspend_unless_pkgpart.pm @@ -3,9 +3,9 @@ package FS::part_event::Action::suspend_unless_pkgpart; 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 { ( @@ -18,12 +18,10 @@ sub option_fields { 'reason_class' => 'S', }, ); -}; - -sub default_weight { - 10; } +sub default_weight { 10; } + sub do_action { my( $self, $cust_object ) = @_; diff --git a/FS/FS/part_event/Condition.pm b/FS/FS/part_event/Condition.pm index 2b71fbb77..544b560b6 100644 --- a/FS/FS/part_event/Condition.pm +++ b/FS/FS/part_event/Condition.pm @@ -2,7 +2,7 @@ package FS::part_event::Condition; use strict; use base qw( FS::part_event_condition ); - +use Time::Local qw(timelocal_nocheck); use FS::UID qw( driver_name ); =head1 NAME @@ -251,6 +251,40 @@ sub option_label { =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 diff --git a/FS/FS/part_event/Condition/balance.pm b/FS/FS/part_event/Condition/balance.pm index 263941351..65670c030 100644 --- a/FS/FS/part_event/Condition/balance.pm +++ b/FS/FS/part_event/Condition/balance.pm @@ -40,7 +40,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql > $over"; + "$balance_sql > CAST( $over AS numeric )"; } diff --git a/FS/FS/part_event/Condition/balance_age.pm b/FS/FS/part_event/Condition/balance_age.pm index ec3624a6d..f1a970796 100644 --- a/FS/FS/part_event/Condition/balance_age.pm +++ b/FS/FS/part_event/Condition/balance_age.pm @@ -1,9 +1,6 @@ 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'; } @@ -28,29 +25,9 @@ sub condition { 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 { @@ -61,7 +38,7 @@ 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 { diff --git a/FS/FS/part_event/Condition/balance_under.pm b/FS/FS/part_event/Condition/balance_under.pm index 5e1903468..9c7159011 100644 --- a/FS/FS/part_event/Condition/balance_under.pm +++ b/FS/FS/part_event/Condition/balance_under.pm @@ -34,7 +34,7 @@ sub condition_sql { my $balance_sql = FS::cust_main->balance_sql; - "$balance_sql <= $under"; + "$balance_sql <= CAST( $under AS numeric )"; } diff --git a/FS/FS/part_event/Condition/cust_bill_age.pm b/FS/FS/part_event/Condition/cust_bill_age.pm index 5c1e46869..f34367320 100644 --- a/FS/FS/part_event/Condition/cust_bill_age.pm +++ b/FS/FS/part_event/Condition/cust_bill_age.pm @@ -1,14 +1,9 @@ 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, @@ -17,10 +12,8 @@ sub eventtable_hashref { }; } -#something like this sub option_fields { ( - #'days' => { label=>'Days', size=>3, }, 'age' => { label=>'Age', type=>'freq', }, ); } @@ -28,34 +21,12 @@ sub option_fields { 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 ) = @_; diff --git a/FS/FS/part_event/Condition/cust_bill_has_service.pm b/FS/FS/part_event/Condition/cust_bill_has_service.pm index 7e63e0e6d..91d75ddac 100644 --- a/FS/FS/part_event/Condition/cust_bill_has_service.pm +++ b/FS/FS/part_event/Condition/cust_bill_has_service.pm @@ -45,7 +45,7 @@ sub condition_sql { 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; diff --git a/FS/FS/part_event/Condition/cust_bill_owed.pm b/FS/FS/part_event/Condition/cust_bill_owed.pm index 5e582ef69..0fd992282 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed.pm @@ -48,7 +48,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql > $over"; + "$owed_sql > CAST( $over AS numeric )"; } 1; diff --git a/FS/FS/part_event/Condition/cust_bill_owed_under.pm b/FS/FS/part_event/Condition/cust_bill_owed_under.pm index 460e6a4be..a0bf92f27 100644 --- a/FS/FS/part_event/Condition/cust_bill_owed_under.pm +++ b/FS/FS/part_event/Condition/cust_bill_owed_under.pm @@ -43,7 +43,7 @@ sub condition_sql { my $owed_sql = FS::cust_bill->owed_sql; - "$owed_sql <= $under"; + "$owed_sql <= CAST( $under AS numeric )"; } 1; diff --git a/FS/FS/part_event/Condition/cust_payments.pm b/FS/FS/part_event/Condition/cust_payments.pm new file mode 100644 index 000000000..41ef6c74a --- /dev/null +++ b/FS/FS/part_event/Condition/cust_payments.pm @@ -0,0 +1,43 @@ +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; + diff --git a/FS/FS/part_event/Condition/has_referral_custnum.pm b/FS/FS/part_event/Condition/has_referral_custnum.pm new file mode 100644 index 000000000..d43d6c0c7 --- /dev/null +++ b/FS/FS/part_event/Condition/has_referral_custnum.pm @@ -0,0 +1,24 @@ +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; diff --git a/FS/FS/part_event/Condition/once_percust.pm b/FS/FS/part_event/Condition/once_percust.pm new file mode 100644 index 000000000..b8a8fbfb6 --- /dev/null +++ b/FS/FS/part_event/Condition/once_percust.pm @@ -0,0 +1,67 @@ +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; diff --git a/FS/FS/part_event/Condition/pkg_age.pm b/FS/FS/part_event/Condition/pkg_age.pm new file mode 100644 index 000000000..8b3b4c971 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_age.pm @@ -0,0 +1,58 @@ +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; + diff --git a/FS/FS/part_event/Condition/pkg_notchange.pm b/FS/FS/part_event/Condition/pkg_notchange.pm new file mode 100644 index 000000000..4c103c22d --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_notchange.pm @@ -0,0 +1,31 @@ +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; + diff --git a/FS/FS/part_event/Condition/pkg_pkgpart.pm b/FS/FS/part_event/Condition/pkg_pkgpart.pm new file mode 100644 index 000000000..6adef8eb6 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_pkgpart.pm @@ -0,0 +1,39 @@ +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; diff --git a/FS/FS/part_event/Condition/pkg_recurring.pm b/FS/FS/part_event/Condition/pkg_recurring.pm new file mode 100644 index 000000000..1b6682126 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_recurring.pm @@ -0,0 +1,31 @@ +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; + diff --git a/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm b/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm new file mode 100644 index 000000000..47fa8c321 --- /dev/null +++ b/FS/FS/part_event/Condition/pkg_unless_pkgpart.pm @@ -0,0 +1,39 @@ +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; diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm index 21b3f1eab..7a78d0ba4 100644 --- a/FS/FS/part_pkg/flat.pm +++ b/FS/FS/part_pkg/flat.pm @@ -142,6 +142,14 @@ sub base_recur { $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) = @_; |