FS/FS/quotation_pkg.pm

   1 package FS::quotation_pkg;
   2
   3 use strict;
   4 use base qw( FS::TemplateItem_Mixin FS::Record );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use FS::part_pkg;
   7 use FS::cust_location;
   8 use FS::quotation;
   9 use FS::quotation_pkg_discount; #so its loaded when TemplateItem_Mixin needs it
  10 use FS::quotation_pkg_detail;
  11 use List::Util qw(sum);
  12
  13 =head1 NAME
  14
  15 FS::quotation_pkg - Object methods for quotation_pkg records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::quotation_pkg;
  20
  21   $record = new FS::quotation_pkg \%hash;
  22   $record = new FS::quotation_pkg { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::quotation_pkg object represents a quotation package.
  35 FS::quotation_pkg inherits from FS::Record.  The following fields are currently
  36 supported:
  37
  38 =over 4
  39
  40 =item quotationpkgnum
  41
  42 primary key
  43
  44 =item pkgpart
  45
  46 pkgpart (L<FS::part_pkg>) of the package
  47
  48 =item locationnum
  49
  50 locationnum (L<FS::cust_location>) where the package will be in service
  51
  52 =item start_date
  53
  54 expected start date for the package, as a timestamp
  55
  56 =item contract_end
  57
  58 contract end date
  59
  60 =item quantity
  61
  62 quantity
  63
  64 =item waive_setup
  65
  66 'Y' to waive the setup fee
  67
  68 =item unitsetup
  69
  70 The amount per package that will be charged in setup/one-time fees.
  71
  72 =item unitrecur
  73
  74 The amount per package that will be charged per billing cycle.
  75
  76 =back
  77
  78 =head1 METHODS
  79
  80 =over 4
  81
  82 =item new HASHREF
  83
  84 Creates a new quotation package.  To add the quotation package to the database,
  85 see L<"insert">.
  86
  87 Note that this stores the hash reference, not a distinct copy of the hash it
  88 points to.  You can ask the object for a copy with the I<hash> method.
  89
  90 =cut
  91
  92 sub table { 'quotation_pkg'; }
  93
  94 sub display_table         { 'quotation_pkg'; }
  95
  96 #forget it, just overriding cust_bill_pkg_display entirely
  97 #sub display_table_orderby { 'quotationpkgnum'; } # something else?
  98 #                                                 #  (for invoice display order)
  99
 100 sub discount_table        { 'quotation_pkg_discount'; }
 101 sub detail_table          { 'quotation_pkg_detail'; }
 102
 103 =item insert
 104
 105 Adds this record to the database.  If there is an error, returns the error,
 106 otherwise returns false.
 107
 108 =cut
 109
 110 sub insert {
 111   my ($self, %options) = @_;
 112
 113   my $dbh = dbh;
 114   my $oldAutoCommit = $FS::UID::AutoCommit;
 115   local $FS::UID::AutoCommit = 0;
 116
 117   #false laziness w/cust_main::Packages::order_pkg
 118   if ( $options{'locationnum'} and $options{'locationnum'} != -1 ) {
 119
 120     $self->locationnum($options{'locationnum'});
 121
 122   } elsif ( $options{'cust_location'} ) {
 123
 124     my $error = $options{'cust_location'}->find_or_insert;
 125     if ( $error ) {
 126       $dbh->rollback if $oldAutoCommit;
 127       return "inserting cust_location (transaction rolled back): $error";
 128     }
 129     $self->locationnum($options{'cust_location'}->locationnum);
 130
 131   }
 132
 133   my $error = $self->SUPER::insert;
 134
 135   if ( !$error and $self->discountnum ) {
 136     $error = $self->insert_discount;
 137     $error .= ' (setting discount)' if $error;
 138   }
 139
 140   # update $self and any discounts with their amounts
 141   if ( !$error ) {
 142     $error = $self->estimate;
 143     $error .= ' (calculating charges)' if $error;
 144   }
 145
 146   if ( $error ) {
 147     $dbh->rollback if $oldAutoCommit;
 148     return $error;
 149   } else {
 150     $dbh->commit if $oldAutoCommit;
 151     return '';
 152   }
 153 }
 154
 155 =item delete
 156
 157 Delete this record from the database.
 158
 159 =cut
 160
 161 sub delete {
 162   my $self = shift;
 163
 164   my $dbh = dbh;
 165   my $oldAutoCommit = $FS::UID::AutoCommit;
 166   local $FS::UID::AutoCommit = 0;
 167
 168   my $error = $self->delete_details;
 169   if ( $error ) {
 170     $dbh->rollback if $oldAutoCommit;
 171     return $error;
 172   }
 173
 174   foreach ($self->quotation_pkg_discount, $self->quotation_pkg_tax) {
 175     $error = $_->delete;
 176     if ( $error ) {
 177       $dbh->rollback if $oldAutoCommit;
 178       return $error . ' (deleting discount)';
 179     }
 180   }
 181
 182   $error = $self->SUPER::delete;
 183   if ( $error ) {
 184     $dbh->rollback if $oldAutoCommit;
 185     return $error;
 186   } else {
 187     $dbh->commit if $oldAutoCommit;
 188     return '';
 189   }
 190
 191 }
 192
 193 =item replace OLD_RECORD
 194
 195 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 196 returns the error, otherwise returns false.
 197
 198 =item check
 199
 200 Checks all fields to make sure this is a valid quotation package.  If there is
 201 an error, returns the error, otherwise returns false.  Called by the insert
 202 and replace methods.
 203
 204 =cut
 205
 206 sub check {
 207   my $self = shift;
 208
 209   my $error =
 210     $self->ut_numbern('quotationpkgnum')
 211     || $self->ut_foreign_key(  'quotationnum', 'quotation',    'quotationnum' )
 212     || $self->ut_foreign_key(  'pkgpart',      'part_pkg',     'pkgpart'      )
 213     || $self->ut_foreign_keyn( 'locationnum', 'cust_location', 'locationnum'  )
 214     || $self->ut_numbern('start_date')
 215     || $self->ut_numbern('contract_end')
 216     || $self->ut_numbern('quantity')
 217     || $self->ut_moneyn('unitsetup')
 218     || $self->ut_moneyn('unitrecur')
 219     || $self->ut_enum('waive_setup', [ '', 'Y'] )
 220   ;
 221
 222   if ($self->locationnum eq '') {
 223     # use the customer default
 224     my $quotation = $self->quotation;
 225     if ($quotation->custnum) {
 226       $self->set('locationnum', $quotation->cust_main->ship_locationnum);
 227     } elsif ($quotation->prospectnum) {
 228       # use the first non-disabled location for that prospect
 229       my $cust_location = qsearchs('cust_location',
 230         { prospectnum => $quotation->prospectnum,
 231           disabled => '' });
 232       $self->set('locationnum', $cust_location->locationnum) if $cust_location;
 233     } # else the quotation is invalid
 234   }
 235
 236   return $error if $error;
 237
 238   $self->SUPER::check;
 239 }
 240
 241 sub part_pkg {
 242   my $self = shift;
 243   qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } );
 244 }
 245
 246 sub desc {
 247   my $self = shift;
 248   $self->part_pkg->pkg;
 249 }
 250
 251 =item estimate
 252
 253 Update the quotation_pkg record with the estimated setup and recurring
 254 charges for the package. Returns nothing on success, or an error message
 255 on failure.
 256
 257 =cut
 258
 259 sub estimate {
 260   my $self = shift;
 261
 262   my( $unitsetup, $unitrecur ) = (0, 0);
 263   foreach my $part_pkg ( $self->part_pkg->self_and_bill_linked ) {
 264
 265     $unitsetup += $part_pkg->option('setup_fee',1) || '0' # 3.x only
 266       unless $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'};
 267
 268     $unitrecur += $part_pkg->base_recur
 269       unless $self->{'_NO_RECUR_KLUDGE'};
 270
 271   }
 272
 273   $self->set('unitsetup', sprintf('%.2f', $unitsetup) );
 274   $self->set('unitrecur', sprintf('%.2f', $unitrecur) );
 275   my $error = $self->replace;
 276   return $error if $error;
 277
 278   # semi-duplicates calc_discount
 279   my $setup_discount = 0;
 280   my $recur_discount = 0;
 281
 282   my %setup_discounts; # quotationpkgdiscountnum => amount
 283   my %recur_discounts; # quotationpkgdiscountnum => amount
 284
 285   # XXX the order of applying discounts is ill-defined, which matters
 286   # if there are percentage and amount discounts on the same package.
 287   #
 288   # but right now there can only be one discount on any package, so
 289   # it doesn't matter
 290   foreach my $pkg_discount ($self->quotation_pkg_discount) {
 291
 292     my $discount = $pkg_discount->discount;
 293     my $this_setup_discount = 0;
 294     my $this_recur_discount = 0;
 295
 296     if ( $discount->percent > 0 ) {
 297
 298       if ( $discount->setup ) {
 299         $this_setup_discount = ($discount->percent * $unitsetup / 100);
 300       }
 301       $this_recur_discount = ($discount->percent * $unitrecur / 100);
 302
 303     } elsif ( $discount->amount > 0 ) {
 304
 305       my $discount_left = $discount->amount;
 306       if ( $discount->setup ) {
 307         if ( $discount_left > $unitsetup - $setup_discount ) {
 308           # then discount the setup to zero
 309           $discount_left -= $unitsetup - $setup_discount;
 310           $this_setup_discount = $unitsetup - $setup_discount;
 311         } else {
 312           # not enough discount to fully cover the setup
 313           $this_setup_discount = $discount_left;
 314           $discount_left = 0;
 315         }
 316       }
 317       # same logic for recur
 318       if ( $discount_left > $unitrecur - $recur_discount ) {
 319         $this_recur_discount = $unitrecur - $recur_discount;
 320       } else {
 321         $this_recur_discount = $discount_left;
 322       }
 323
 324     }
 325
 326     # increment the total discountage
 327     $setup_discount += $this_setup_discount;
 328     $recur_discount += $this_recur_discount;
 329     # and update the pkg_discount object
 330     $pkg_discount->set('setup_amount', sprintf('%.2f', $setup_discount));
 331     $pkg_discount->set('recur_amount', sprintf('%.2f', $recur_discount));
 332     my $error = $pkg_discount->replace;
 333     return $error if $error;
 334   }
 335
 336   '';
 337 }
 338
 339 =item insert_discount
 340
 341 Associates this package with a discount (see L<FS::cust_pkg_discount>,
 342 possibly inserting a new discount on the fly (see L<FS::discount>). Properties
 343 of the discount will be taken from this object.
 344
 345 =cut
 346
 347 sub insert_discount {
 348   #my ($self, %options) = @_;
 349   my $self = shift;
 350
 351   my $quotation_pkg_discount = FS::quotation_pkg_discount->new( {
 352     'quotationpkgnum' => $self->quotationpkgnum,
 353     'discountnum'     => $self->discountnum,
 354     #for the create a new discount case
 355     '_type'           => $self->discountnum__type,
 356     'amount'      => $self->discountnum_amount,
 357     'percent'     => $self->discountnum_percent,
 358     'months'      => $self->discountnum_months,
 359     'setup'       => $self->discountnum_setup,
 360   } );
 361
 362   $quotation_pkg_discount->insert;
 363 }
 364
 365 sub _item_discount {
 366   my $self = shift;
 367   my @pkg_discounts = $self->pkg_discount;
 368   return if @pkg_discounts == 0;
 369
 370   my @ext;
 371   my $d = {
 372     _is_discount    => 1,
 373     description     => $self->mt('Discount'),
 374     setup_amount    => 0,
 375     recur_amount    => 0,
 376     amount          => 0,
 377     ext_description => \@ext,
 378     # maybe should show quantity/unit discount?
 379   };
 380   foreach my $pkg_discount (@pkg_discounts) {
 381     push @ext, $pkg_discount->description;
 382     $d->{setup_amount} -= $pkg_discount->setup_amount;
 383     $d->{recur_amount} -= $pkg_discount->recur_amount;
 384   }
 385   $d->{setup_amount} *= $self->quantity || 1;
 386   $d->{recur_amount} *= $self->quantity || 1;
 387   $d->{amount} = $d->{setup_amount} + $d->{recur_amount};
 388
 389   return $d;
 390 }
 391
 392 sub setup {
 393   my $self = shift;
 394   ($self->unitsetup - sum(0, map { $_->setup_amount } $self->pkg_discount))
 395     * ($self->quantity || 1);
 396 }
 397
 398 sub setup_show_zero {
 399   my $self = shift;
 400   return $self->part_pkg->setup_show_zero;
 401 }
 402
 403 sub recur {
 404   my $self = shift;
 405   ($self->unitrecur - sum(0, map { $_->recur_amount } $self->pkg_discount))
 406     * ($self->quantity || 1);
 407 }
 408
 409 sub recur_show_zero {
 410   my $self = shift;
 411   return $self->part_pkg->recur_show_zero;
 412 }
 413
 414 =item delete_details
 415
 416 Deletes all quotation_pkgs_details associated with this pkg (see L<FS::quotation_pkg_detail>).
 417
 418 =cut
 419
 420 sub delete_details {
 421   my $self = shift;
 422
 423   my $oldAutoCommit = $FS::UID::AutoCommit;
 424   local $FS::UID::AutoCommit = 0;
 425   my $dbh = dbh;
 426
 427   foreach my $detail ( qsearch('quotation_pkg_detail',{ 'quotationpkgnum' => $self->quotationpkgnum }) ) {
 428     my $error = $detail->delete;
 429     if ( $error ) {
 430       $dbh->rollback if $oldAutoCommit;
 431       return "error removing old detail: $error";
 432     }
 433   }
 434
 435   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 436   '';
 437
 438 }
 439
 440 =item set_details PARAM
 441
 442 Sets new quotation details for this package (see L<FS::quotation_pkg_detail>),
 443 removing existing details.
 444
 445 Recognizes the following parameters:
 446
 447 details - arrayref of strings, one for each new detail
 448
 449 copy_on_order - if true, sets copy_on_order flag on new details
 450
 451 If there is an error, returns the error, otherwise returns false.
 452
 453 =cut
 454
 455 sub set_details {
 456   my $self = shift;
 457   my %opt = @_;
 458
 459   $opt{'details'} ||= [];
 460   my @details = @{$opt{'details'}};
 461
 462   my $oldAutoCommit = $FS::UID::AutoCommit;
 463   local $FS::UID::AutoCommit = 0;
 464   my $dbh = dbh;
 465
 466   my $error = $self->delete_details;
 467   if ( $error ) {
 468     $dbh->rollback if $oldAutoCommit;
 469     return $error;
 470   }
 471
 472   foreach my $detail ( @details ) {
 473     my $quotation_pkg_detail = new FS::quotation_pkg_detail {
 474       'quotationpkgnum' => $self->quotationpkgnum,
 475       'detail' => $detail,
 476       'copy_on_order' => $opt{'copy_on_order'} ? 'Y' : '',
 477     };
 478     $error = $quotation_pkg_detail->insert;
 479     if ( $error ) {
 480       $dbh->rollback if $oldAutoCommit;
 481       return "error adding new detail: $error";
 482     }
 483   }
 484
 485   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 486   '';
 487
 488 }
 489
 490 sub details_header {
 491   return ();
 492 }
 493
 494 =item cust_bill_pkg_display [ type => TYPE ]
 495
 496 =cut
 497
 498 sub cust_bill_pkg_display {
 499   my ( $self, %opt ) = @_;
 500
 501   my $type = $opt{type} if exists $opt{type};
 502   return () if $type eq 'U'; #quotations don't have usage
 503
 504   if ( $self->get('display') ) {
 505     return ( grep { defined($type) ? ($type eq $_->type) : 1 }
 506                @{ $self->get('display') }
 507            );
 508   } else {
 509
 510     #??
 511     my $setup = $self->new($self->hashref);
 512     $setup->{'_NO_RECUR_KLUDGE'} = 1;
 513     $setup->{'type'} = 'S';
 514     my $recur = $self->new($self->hashref);
 515     $recur->{'_NO_SETUP_KLUDGE'} = 1;
 516     $recur->{'type'} = 'R';
 517
 518     if ( $type eq 'S' ) {
 519       return ($setup);
 520     } elsif ( $type eq 'R' ) {
 521       return ($recur);
 522     } else {
 523       #return ($setup, $recur);
 524       return ($self);
 525     }
 526
 527   }
 528
 529 }
 530
 531 =item cust_main
 532
 533 Returns the customer (L<FS::cust_main> object).
 534
 535 =cut
 536
 537 sub cust_main {
 538   my $self = shift;
 539   my $quotation = FS::quotation->by_key($self->quotationnum) or return '';
 540   $quotation->cust_main;
 541 }
 542
 543 sub tax_locationnum {
 544   my $self = shift;
 545   $self->locationnum;
 546 }
 547
 548 #stub for 3.x
 549
 550 sub quotation {
 551   my $self = shift;
 552   FS::quotation->by_key($self->quotationnum);
 553 }
 554
 555 sub quotation_pkg_detail {
 556   my $self = shift;
 557   sort { $a->detailnum <=> $b->detailnum }
 558     qsearch('quotation_pkg_detail', { quotationpkgnum => $self->quotationpkgnum });
 559 }
 560
 561 sub quotation_pkg_discount {
 562   my $self = shift;
 563   qsearch('quotation_pkg_discount', { quotationpkgnum => $self->quotationpkgnum });
 564 }
 565
 566 sub quotation_pkg_tax {
 567   my $self = shift;
 568   qsearch('quotation_pkg_tax', { quotationpkgnum => $self->quotationpkgnum });
 569 }
 570
 571 sub cust_location {
 572   my $self = shift;
 573   $self->locationnum ? qsearchs('cust_location', { locationnum => $self->locationnum }) : '';
 574 }
 575
 576
 577 sub _upgrade_data {
 578   my $class = shift;
 579   my @quotation_pkg_without_location =
 580     qsearch( 'quotation_pkg', { locationnum => '' } );
 581   if (@quotation_pkg_without_location) {
 582     warn "setting default location on quotation_pkg records\n";
 583     foreach my $quotation_pkg (@quotation_pkg_without_location) {
 584       # check() will fix this
 585       my $error = $quotation_pkg->replace;
 586       if ($error) {
 587         die "quotation #".$quotation_pkg->quotationnum.": $error\n";
 588       }
 589     }
 590   }
 591   '';
 592 }
 593
 594 =back
 595
 596 =head1 BUGS
 597
 598 Doesn't support fees, or add-on packages.
 599
 600 =head1 SEE ALSO
 601
 602 L<FS::Record>, schema.html from the base documentation.
 603
 604 =cut
 605
 606 1;
 607