X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fquotation_pkg.pm;h=3f6742c7997eb7005d340530439ae87e4675d3a6;hp=3813fb22c3d5647faa1d3941dc10ef5f7ec506ea;hb=5372897f367498972c96f5494e142e6e11b29eb8;hpb=5b884dd940f7dce415ba77dcbc2ab6840f0b5673 diff --git a/FS/FS/quotation_pkg.pm b/FS/FS/quotation_pkg.pm index 3813fb22c..3f6742c79 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 @@ -95,11 +101,16 @@ sub display_table { 'quotation_pkg'; } # # (for invoice display order) sub discount_table { 'quotation_pkg_discount'; } +sub detail_table { 'quotation_pkg_detail'; } =item insert Adds this record to the database. If there is an error, returns the error, -otherwise returns false. +otherwise returns false. Accepts the following options: + +quotation_details - optional arrayref of detail strings to add (creates quotation_pkg_detail records) + +copy_on_order - value for this field when creating quotation_pkg_detail records (same for all details) =cut @@ -110,26 +121,49 @@ sub insert { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; + #false laziness w/cust_main::Packages::order_pkg + if ( $options{'locationnum'} and $options{'locationnum'} != -1 ) { + + $self->locationnum($options{'locationnum'}); + + } elsif ( $options{'cust_location'} ) { + + my $error = $options{'cust_location'}->find_or_insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $self->locationnum($options{'cust_location'}->locationnum); + + } + 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; - } else { - $dbh->commit if $oldAutoCommit; - return ''; } + + if ($options{'quotation_details'}) { + $error = $self->set_details( + details => $options{'quotation_details'}, + copy_on_order => $options{'copy_on_order'} ? 'Y' : '', + ); + if ( $error ) { + $error .= ' (setting details)'; + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit if $oldAutoCommit; + return ''; } =item delete @@ -145,23 +179,29 @@ sub delete { my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; - foreach ($self->quotation_pkg_discount) { - my $error = $_->delete; + my $error = $self->delete_details; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach ($self->quotation_pkg_discount, $self->quotation_pkg_tax) { + $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 +220,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 +232,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,96 +267,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. - 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, @@ -312,57 +281,96 @@ sub insert_discount { #my ($self, %options) = @_; my $self = shift; - my $cust_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, - } ); - - $cust_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; - } - $d->{setup_amount} *= $self->quantity || 1; - $d->{recur_amount} *= $self->quantity || 1; - $d->{amount} = $d->{setup_amount} + $d->{recur_amount}; + my $amount = $pkg_discount->get('amount'); + $d->{amount} -= $amount; + } + $d->{amount} = sprintf('%.2f', $d->{amount} * $self->quantity); return $d; } sub setup { my $self = shift; - ($self->unitsetup - sum(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_show_zero { + my $self = shift; + return $self->part_pkg->setup_show_zero; +} + +sub setup_tax { + my $self = shift; + sum(0, map { $_->setup_amount } $self->quotation_pkg_tax); } sub recur { my $self = shift; - ($self->unitrecur - sum(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_show_zero { + my $self = shift; + return $self->part_pkg->recur_show_zero; +} + +sub recur_tax { + my $self = shift; + sum(0, map { $_->recur_amount } $self->quotation_pkg_tax); } =item part_pkg_currency_option OPTIONNAME @@ -388,6 +396,85 @@ 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',{ 'quotationpkgnum' => $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 PARAM + +Sets new quotation details for this package (see L), +removing existing details. + +Recognizes the following parameters: + +details - arrayref of strings, one for each new detail + +copy_on_order - if true, sets copy_on_order flag on new details + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub set_details { + my $self = shift; + my %opt = @_; + + $opt{'details'} ||= []; + my @details = @{$opt{'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 { + 'quotationpkgnum' => $self->quotationpkgnum, + 'detail' => $detail, + 'copy_on_order' => $opt{'copy_on_order'} ? 'Y' : '', + }; + $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; + ''; + +} + +sub details_header { + return (); +} =item cust_bill_pkg_display [ type => TYPE ] @@ -434,7 +521,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; } @@ -446,15 +533,37 @@ 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 tax_locationnum { + my $self = shift; + $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 =head1 BUGS -Doesn't support taxes, fees, or add-on packages. +Doesn't support fees, or add-on packages. =head1 SEE ALSO