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   my $part_pkg = $self->part_pkg;
 262   my $quantity = $self->quantity || 1;
 263   my ($unitsetup, $unitrecur);
 264   # calculate base fees
 265   if ( $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'} ) {
 266     $unitsetup = '0.00';
 267   } else {
 268     $unitsetup = $part_pkg->option('setup_fee',1) || '0.00'; # XXX 3.x only
 269   }
 270   if ( $self->{'_NO_RECUR_KLUDGE'} ) {
 271     $unitrecur = '0.00';
 272   } else {
 273     $unitrecur = $part_pkg->base_recur;
 274   }
 275
 276   #XXX add-on packages
 277
 278   $self->set('unitsetup', $unitsetup);
 279   $self->set('unitrecur', $unitrecur);
 280   my $error = $self->replace;
 281   return $error if $error;
 282
 283   # semi-duplicates calc_discount
 284   my $setup_discount = 0;
 285   my $recur_discount = 0;
 286
 287   my %setup_discounts; # quotationpkgdiscountnum => amount
 288   my %recur_discounts; # quotationpkgdiscountnum => amount
 289
 290   # XXX the order of applying discounts is ill-defined, which matters
 291   # if there are percentage and amount discounts on the same package.
 292   #
 293   # but right now there can only be one discount on any package, so
 294   # it doesn't matter
 295   foreach my $pkg_discount ($self->quotation_pkg_discount) {
 296
 297     my $discount = $pkg_discount->discount;
 298     my $this_setup_discount = 0;
 299     my $this_recur_discount = 0;
 300
 301     if ( $discount->percent > 0 ) {
 302
 303       if ( $discount->setup ) {
 304         $this_setup_discount = ($discount->percent * $unitsetup / 100);
 305       }
 306       $this_recur_discount = ($discount->percent * $unitrecur / 100);
 307
 308     } elsif ( $discount->amount > 0 ) {
 309
 310       my $discount_left = $discount->amount;
 311       if ( $discount->setup ) {
 312         if ( $discount_left > $unitsetup - $setup_discount ) {
 313           # then discount the setup to zero
 314           $discount_left -= $unitsetup - $setup_discount;
 315           $this_setup_discount = $unitsetup - $setup_discount;
 316         } else {
 317           # not enough discount to fully cover the setup
 318           $this_setup_discount = $discount_left;
 319           $discount_left = 0;
 320         }
 321       }
 322       # same logic for recur
 323       if ( $discount_left > $unitrecur - $recur_discount ) {
 324         $this_recur_discount = $unitrecur - $recur_discount;
 325       } else {
 326         $this_recur_discount = $discount_left;
 327       }
 328
 329     }
 330
 331     # increment the total discountage
 332     $setup_discount += $this_setup_discount;
 333     $recur_discount += $this_recur_discount;
 334     # and update the pkg_discount object
 335     $pkg_discount->set('setup_amount', sprintf('%.2f', $setup_discount));
 336     $pkg_discount->set('recur_amount', sprintf('%.2f', $recur_discount));
 337     my $error = $pkg_discount->replace;
 338     return $error if $error;
 339   }
 340
 341   '';
 342 }
 343
 344 =item insert_discount
 345
 346 Associates this package with a discount (see L<FS::cust_pkg_discount>,
 347 possibly inserting a new discount on the fly (see L<FS::discount>). Properties
 348 of the discount will be taken from this object.
 349
 350 =cut
 351
 352 sub insert_discount {
 353   #my ($self, %options) = @_;
 354   my $self = shift;
 355
 356   my $quotation_pkg_discount = FS::quotation_pkg_discount->new( {
 357     'quotationpkgnum' => $self->quotationpkgnum,
 358     'discountnum'     => $self->discountnum,
 359     #for the create a new discount case
 360     '_type'           => $self->discountnum__type,
 361     'amount'      => $self->discountnum_amount,
 362     'percent'     => $self->discountnum_percent,
 363     'months'      => $self->discountnum_months,
 364     'setup'       => $self->discountnum_setup,
 365   } );
 366
 367   $quotation_pkg_discount->insert;
 368 }
 369
 370 sub _item_discount {
 371   my $self = shift;
 372   my @pkg_discounts = $self->pkg_discount;
 373   return if @pkg_discounts == 0;
 374
 375   my @ext;
 376   my $d = {
 377     _is_discount    => 1,
 378     description     => $self->mt('Discount'),
 379     setup_amount    => 0,
 380     recur_amount    => 0,
 381     amount          => 0,
 382     ext_description => \@ext,
 383     # maybe should show quantity/unit discount?
 384   };
 385   foreach my $pkg_discount (@pkg_discounts) {
 386     push @ext, $pkg_discount->description;
 387     $d->{setup_amount} -= $pkg_discount->setup_amount;
 388     $d->{recur_amount} -= $pkg_discount->recur_amount;
 389   }
 390   $d->{setup_amount} *= $self->quantity || 1;
 391   $d->{recur_amount} *= $self->quantity || 1;
 392   $d->{amount} = $d->{setup_amount} + $d->{recur_amount};
 393
 394   return $d;
 395 }
 396
 397 sub setup {
 398   my $self = shift;
 399   ($self->unitsetup - sum(0, map { $_->setup_amount } $self->pkg_discount))
 400     * ($self->quantity || 1);
 401 }
 402
 403 sub setup_show_zero {
 404   my $self = shift;
 405   return $self->part_pkg->setup_show_zero;
 406 }
 407
 408 sub recur {
 409   my $self = shift;
 410   ($self->unitrecur - sum(0, map { $_->recur_amount } $self->pkg_discount))
 411     * ($self->quantity || 1);
 412 }
 413
 414 sub recur_show_zero {
 415   my $self = shift;
 416   return $self->part_pkg->recur_show_zero;
 417 }
 418
 419 =item delete_details
 420
 421 Deletes all quotation_pkgs_details associated with this pkg (see L<FS::quotation_pkg_detail>).
 422
 423 =cut
 424
 425 sub delete_details {
 426   my $self = shift;
 427
 428   my $oldAutoCommit = $FS::UID::AutoCommit;
 429   local $FS::UID::AutoCommit = 0;
 430   my $dbh = dbh;
 431
 432   foreach my $detail ( qsearch('quotation_pkg_detail',{ 'quotationpkgnum' => $self->quotationpkgnum }) ) {
 433     my $error = $detail->delete;
 434     if ( $error ) {
 435       $dbh->rollback if $oldAutoCommit;
 436       return "error removing old detail: $error";
 437     }
 438   }
 439
 440   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 441   '';
 442
 443 }
 444
 445 =item set_details PARAM
 446
 447 Sets new quotation details for this package (see L<FS::quotation_pkg_detail>),
 448 removing existing details.
 449
 450 Recognizes the following parameters:
 451
 452 details - arrayref of strings, one for each new detail
 453
 454 copy_on_order - if true, sets copy_on_order flag on new details
 455
 456 If there is an error, returns the error, otherwise returns false.
 457
 458 =cut
 459
 460 sub set_details {
 461   my $self = shift;
 462   my %opt = @_;
 463
 464   $opt{'details'} ||= [];
 465   my @details = @{$opt{'details'}};
 466
 467   my $oldAutoCommit = $FS::UID::AutoCommit;
 468   local $FS::UID::AutoCommit = 0;
 469   my $dbh = dbh;
 470
 471   my $error = $self->delete_details;
 472   if ( $error ) {
 473     $dbh->rollback if $oldAutoCommit;
 474     return $error;
 475   }
 476
 477   foreach my $detail ( @details ) {
 478     my $quotation_pkg_detail = new FS::quotation_pkg_detail {
 479       'quotationpkgnum' => $self->quotationpkgnum,
 480       'detail' => $detail,
 481       'copy_on_order' => $opt{'copy_on_order'} ? 'Y' : '',
 482     };
 483     $error = $quotation_pkg_detail->insert;
 484     if ( $error ) {
 485       $dbh->rollback if $oldAutoCommit;
 486       return "error adding new detail: $error";
 487     }
 488   }
 489
 490   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 491   '';
 492
 493 }
 494
 495 sub details_header {
 496   return ();
 497 }
 498
 499 =item cust_bill_pkg_display [ type => TYPE ]
 500
 501 =cut
 502
 503 sub cust_bill_pkg_display {
 504   my ( $self, %opt ) = @_;
 505
 506   my $type = $opt{type} if exists $opt{type};
 507   return () if $type eq 'U'; #quotations don't have usage
 508
 509   if ( $self->get('display') ) {
 510     return ( grep { defined($type) ? ($type eq $_->type) : 1 }
 511                @{ $self->get('display') }
 512            );
 513   } else {
 514
 515     #??
 516     my $setup = $self->new($self->hashref);
 517     $setup->{'_NO_RECUR_KLUDGE'} = 1;
 518     $setup->{'type'} = 'S';
 519     my $recur = $self->new($self->hashref);
 520     $recur->{'_NO_SETUP_KLUDGE'} = 1;
 521     $recur->{'type'} = 'R';
 522
 523     if ( $type eq 'S' ) {
 524       return ($setup);
 525     } elsif ( $type eq 'R' ) {
 526       return ($recur);
 527     } else {
 528       #return ($setup, $recur);
 529       return ($self);
 530     }
 531
 532   }
 533
 534 }
 535
 536 =item cust_main
 537
 538 Returns the customer (L<FS::cust_main> object).
 539
 540 =cut
 541
 542 sub cust_main {
 543   my $self = shift;
 544   my $quotation = FS::quotation->by_key($self->quotationnum) or return '';
 545   $quotation->cust_main;
 546 }
 547
 548 sub tax_locationnum {
 549   my $self = shift;
 550   $self->locationnum;
 551 }
 552
 553 #stub for 3.x
 554
 555 sub quotation {
 556   my $self = shift;
 557   FS::quotation->by_key($self->quotationnum);
 558 }
 559
 560 sub quotation_pkg_detail {
 561   my $self = shift;
 562   sort { $a->detailnum <=> $b->detailnum }
 563     qsearch('quotation_pkg_detail', { quotationpkgnum => $self->quotationpkgnum });
 564 }
 565
 566 sub quotation_pkg_discount {
 567   my $self = shift;
 568   qsearch('quotation_pkg_discount', { quotationpkgnum => $self->quotationpkgnum });
 569 }
 570
 571 sub quotation_pkg_tax {
 572   my $self = shift;
 573   qsearch('quotation_pkg_tax', { quotationpkgnum => $self->quotationpkgnum });
 574 }
 575
 576 sub cust_location {
 577   my $self = shift;
 578   $self->locationnum ? qsearchs('cust_location', { locationnum => $self->locationnum }) : '';
 579 }
 580
 581
 582 sub _upgrade_data {
 583   my $class = shift;
 584   my @quotation_pkg_without_location =
 585     qsearch( 'quotation_pkg', { locationnum => '' } );
 586   if (@quotation_pkg_without_location) {
 587     warn "setting default location on quotation_pkg records\n";
 588     foreach my $quotation_pkg (@quotation_pkg_without_location) {
 589       # check() will fix this
 590       my $error = $quotation_pkg->replace;
 591       if ($error) {
 592         die "quotation #".$quotation_pkg->quotationnum.": $error\n";
 593       }
 594     }
 595   }
 596   '';
 597 }
 598
 599 =back
 600
 601 =head1 BUGS
 602
 603 Doesn't support fees, or add-on packages.
 604
 605 =head1 SEE ALSO
 606
 607 L<FS::Record>, schema.html from the base documentation.
 608
 609 =cut
 610
 611 1;
 612