X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fquotation_pkg.pm;h=49d0d9a5cffe5800a9e0e44cdde1ac1f9b28a895;hb=3888fd6d1902f93c19d62df186e04617357f58c5;hp=c579e359b29ca97457372c470dbbc6adb8878b47;hpb=35c18f29bc29dedfe2fa4ef037390d90b17f87ba;p=freeside.git diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index c579e359b..49d0d9a5c 100644 --- a/FS/FS/quotation_pkg.pm +++ b/FS/FS/quotation_pkg.pm @@ -2,9 +2,10 @@ package FS::quotation_pkg; use base qw( FS::TemplateItem_Mixin FS::Record ); use strict; -use FS::Record qw( qsearchs dbh ); #qsearch +use FS::Record qw( qsearchs qsearch dbh ); use FS::part_pkg; use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it +use FS::quotation_pkg_detail; use List::Util qw(sum); =head1 NAME @@ -70,6 +71,11 @@ The amount per package that will be charged in setup/one-time fees. The amount per package that will be charged per billing cycle. +=item freq + +The length of the billing cycle. If zero it's a one-time charge; if any +other number it's that many months; other values are in L. + =back =head1 METHODS @@ -96,6 +102,20 @@ sub display_table { 'quotation_pkg'; } sub discount_table { 'quotation_pkg_discount'; } +# detail table uses non-quotation fieldnames, see billpkgnum below +sub detail_table { 'quotation_pkg_detail'; } + +=item billpkgnum + +Sets/returns quotationpkgnum, for ease of integration with TemplateItem_Mixin::details + +=cut + +sub billpkgnum { + my $self = shift; + $self->quotationpkgnum(@_); +} + =item insert Adds this record to the database. If there is an error, returns the error, @@ -112,17 +132,12 @@ sub insert { my $error = $self->SUPER::insert; - if ( !$error and $self->discountnum ) { + if ( !$error and ($self->setup_discountnum || $self->recur_discountnum) ) { + #warn "inserting discount\n"; $error = $self->insert_discount; $error .= ' (setting discount)' if $error; } - # update $self and any discounts with their amounts - if ( !$error ) { - $error = $self->estimate; - $error .= ' (calculating charges)' if $error; - } - if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -145,23 +160,29 @@ sub delete { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; + my $error = $self->delete_details; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + foreach ($self->quotation_pkg_discount, $self->quotation_pkg_tax) { - my $error = $_->delete; + $error = $_->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error . ' (deleting discount)'; } } - my $error = $self->SUPER::delete; + $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } else { $dbh->commit if $oldAutoCommit; - return ''; } + $self->quotation->estimate; } =item replace OLD_RECORD @@ -180,6 +201,8 @@ and replace methods. sub check { my $self = shift; + my @freqs = ('', keys (%{ FS::Misc->pkg_freqs })); + my $error = $self->ut_numbern('quotationpkgnum') || $self->ut_foreign_key( 'quotationnum', 'quotation', 'quotationnum' ) @@ -190,9 +213,24 @@ sub check { || $self->ut_numbern('quantity') || $self->ut_moneyn('unitsetup') || $self->ut_moneyn('unitrecur') + || $self->ut_enum('freq', \@freqs) || $self->ut_enum('waive_setup', [ '', 'Y'] ) ; + if ($self->locationnum eq '') { + # use the customer default + my $quotation = $self->quotation; + if ($quotation->custnum) { + $self->set('locationnum', $quotation->cust_main->ship_locationnum); + } elsif ($quotation->prospectnum) { + # use the first non-disabled location for that prospect + my $cust_location = qsearchs('cust_location', + { prospectnum => $quotation->prospectnum, + disabled => '' }); + $self->set('locationnum', $cust_location->locationnum) if $cust_location; + } # else the quotation is invalid + } + return $error if $error; $self->SUPER::check; @@ -210,99 +248,8 @@ sub desc { $self->part_pkg->pkg; } -=item estimate - -Update the quotation_pkg record with the estimated setup and recurring -charges for the package. Returns nothing on success, or an error message -on failure. - =cut -sub estimate { - my $self = shift; - my $part_pkg = $self->part_pkg; - my $quantity = $self->quantity || 1; - my ($unitsetup, $unitrecur); - # calculate base fees - if ( $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'} ) { - $unitsetup = '0.00'; - } else { - $unitsetup = $part_pkg->base_setup; - } - if ( $self->{'_NO_RECUR_KLUDGE'} ) { - $unitrecur = '0.00'; - } else { - $unitrecur = $part_pkg->base_recur; - } - - #XXX add-on packages - - $self->set('unitsetup', $unitsetup); - $self->set('unitrecur', $unitrecur); - my $error = $self->replace; - return $error if $error; - - # semi-duplicates calc_discount - my $setup_discount = 0; - my $recur_discount = 0; - - my %setup_discounts; # quotationpkgdiscountnum => amount - my %recur_discounts; # quotationpkgdiscountnum => amount - - # XXX the order of applying discounts is ill-defined, which matters - # if there are percentage and amount discounts on the same package. - # - # but right now there can only be one discount on any package, so - # it doesn't matter - foreach my $pkg_discount ($self->quotation_pkg_discount) { - - my $discount = $pkg_discount->discount; - my $this_setup_discount = 0; - my $this_recur_discount = 0; - - if ( $discount->percent > 0 ) { - - if ( $discount->setup ) { - $this_setup_discount = ($discount->percent * $unitsetup / 100); - } - $this_recur_discount = ($discount->percent * $unitrecur / 100); - - } elsif ( $discount->amount > 0 ) { - - my $discount_left = $discount->amount; - if ( $discount->setup ) { - if ( $discount_left > $unitsetup - $setup_discount ) { - # then discount the setup to zero - $discount_left -= $unitsetup - $setup_discount; - $this_setup_discount = $unitsetup - $setup_discount; - } else { - # not enough discount to fully cover the setup - $this_setup_discount = $discount_left; - $discount_left = 0; - } - } - # same logic for recur - if ( $discount_left > $unitrecur - $recur_discount ) { - $this_recur_discount = $unitrecur - $recur_discount; - } else { - $this_recur_discount = $discount_left; - } - - } - - # increment the total discountage - $setup_discount += $this_setup_discount; - $recur_discount += $this_recur_discount; - # and update the pkg_discount object - $pkg_discount->set('setup_amount', sprintf('%.2f', $setup_discount)); - $pkg_discount->set('recur_amount', sprintf('%.2f', $recur_discount)); - my $error = $pkg_discount->replace; - return $error if $error; - } - - ''; -} - =item insert_discount Associates this package with a discount (see L, @@ -315,57 +262,86 @@ sub insert_discount { #my ($self, %options) = @_; my $self = shift; - my $quotation_pkg_discount = FS::quotation_pkg_discount->new( { - 'quotationpkgnum' => $self->quotationpkgnum, - 'discountnum' => $self->discountnum, - #for the create a new discount case - '_type' => $self->discountnum__type, - 'amount' => $self->discountnum_amount, - 'percent' => $self->discountnum_percent, - 'months' => $self->discountnum_months, - 'setup' => $self->discountnum_setup, - } ); - - $quotation_pkg_discount->insert; + foreach my $x (qw(setup recur)) { + if ( my $discountnum = $self->get("${x}_discountnum") ) { + my $cust_pkg_discount = FS::quotation_pkg_discount->new( { + 'quotationpkgnum' => $self->quotationpkgnum, + 'discountnum' => $discountnum, + 'setuprecur' => $x, + #for the create a new discount case + 'amount' => $self->get("${x}_discountnum_amount"), + 'percent' => $self->get("${x}_discountnum_percent"), + 'months' => $self->get("${x}_discountnum_months"), + } ); + if ( $x eq 'setup' ) { + $cust_pkg_discount->setup('Y'); + $cust_pkg_discount->months(''); + } + my $error = $cust_pkg_discount->insert; + return $error if $error; + } + } } sub _item_discount { my $self = shift; - my @pkg_discounts = $self->pkg_discount; + my %options = @_; + my $setuprecur = $options{'setuprecur'}; + # a little different from cust_bill_pkg::_item_discount, in that this one + # is asked specifically whether to show setup or recur discounts (because + # on the quotation they're separate sections entirely) + + my @pkg_discounts = grep { $_->setuprecur eq $setuprecur } + $self->pkg_discount; return if @pkg_discounts == 0; my @ext; my $d = { _is_discount => 1, description => $self->mt('Discount'), - setup_amount => 0, - recur_amount => 0, amount => 0, ext_description => \@ext, # maybe should show quantity/unit discount? }; foreach my $pkg_discount (@pkg_discounts) { push @ext, $pkg_discount->description; - $d->{setup_amount} -= $pkg_discount->setup_amount; - $d->{recur_amount} -= $pkg_discount->recur_amount; + my $amount = $pkg_discount->get('amount'); + $d->{amount} -= $amount; } - $d->{setup_amount} *= $self->quantity || 1; - $d->{recur_amount} *= $self->quantity || 1; - $d->{amount} = $d->{setup_amount} + $d->{recur_amount}; + $d->{amount} = sprintf('%.2f', $d->{amount} * $self->quantity); return $d; } sub setup { my $self = shift; - ($self->unitsetup - sum(0, map { $_->setup_amount } $self->pkg_discount)) - * ($self->quantity || 1); + return '0.00' if $self->waive_setup eq 'Y';; + my $discount_amount = sum(0, map { $_->amount } + grep { $_->setuprecur eq 'setup' } + $self->pkg_discount + ); + ($self->unitsetup - $discount_amount) * ($self->quantity || 1); + +} + +sub setup_tax { + my $self = shift; + sum(0, map { $_->setup_amount } $self->quotation_pkg_tax); } sub recur { my $self = shift; - ($self->unitrecur - sum(0, map { $_->recur_amount } $self->pkg_discount)) - * ($self->quantity || 1); + my $discount_amount = sum(0, map { $_->amount } + grep { $_->setuprecur eq 'recur' } + $self->pkg_discount + ); + ($self->unitrecur - $discount_amount) * ($self->quantity || 1); + +} + +sub recur_tax { + my $self = shift; + sum(0, map { $_->recur_amount } $self->quotation_pkg_tax); } =item part_pkg_currency_option OPTIONNAME @@ -391,6 +367,69 @@ sub part_pkg_currency_option { } } +=item delete_details + +Deletes all quotation_pkgs_details associated with this pkg (see L). + +=cut + +sub delete_details { + my $self = shift; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $detail ( qsearch('quotation_pkg_detail',{ 'billpkgnum' => $self->quotationpkgnum }) ) { + my $error = $detail->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error removing old detail: $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item set_details [ DETAIL, DETAIL, ... ] + +Sets quotation details for this package (see L). + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub set_details { + my( $self, @details ) = @_; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error = $self->delete_details; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $detail ( @details ) { + my $quotation_pkg_detail = new FS::quotation_pkg_detail { + 'billpkgnum' => $self->quotationpkgnum, + 'detail' => $detail, + }; + $error = $quotation_pkg_detail->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding new detail: $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} =item cust_bill_pkg_display [ type => TYPE ] @@ -417,11 +456,6 @@ sub cust_bill_pkg_display { $recur->{'type'} = 'R'; if ( $type eq 'S' ) { -sub tax_locationnum { - my $self = shift; - $self->locationnum; -} - return ($setup); } elsif ( $type eq 'R' ) { return ($recur); @@ -442,7 +476,7 @@ Returns the customer (L object). sub cust_main { my $self = shift; - my $quotation = FS::quotation->by_key($self->quotationnum) or return ''; + my $quotation = $self->quotation or return ''; $quotation->cust_main; } @@ -454,18 +488,30 @@ Returns the prospect (L object). sub prospect_main { my $self = shift; - my $quotation = FS::quotation->by_key($self->quotationnum) or return ''; + my $quotation = $self->quotation or return ''; $quotation->prospect_main; } -sub quotation_pkg_tax { +sub tax_locationnum { my $self = shift; - qsearch('quotation_pkg_tax', { quotationpkgnum => $self->quotationpkgnum }); + $self->locationnum; } -sub cust_location { - my $self = shift; - $self->locationnum ? qsearchs('cust_location', { locationnum => $self->locationnum }) : ''; +sub _upgrade_data { + my $class = shift; + my @quotation_pkg_without_location = + qsearch( 'quotation_pkg', { locationnum => '' } ); + if (@quotation_pkg_without_location) { + warn "setting default location on quotation_pkg records\n"; + foreach my $quotation_pkg (@quotation_pkg_without_location) { + # check() will fix this + my $error = $quotation_pkg->replace; + if ($error) { + die "quotation #".$quotation_pkg->quotationnum.": $error\n"; + } + } + } + ''; } =back