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
 102 # detail table uses non-quotation fieldnames, see billpkgnum below
 103 sub detail_table          { 'quotation_pkg_detail'; }
 104
 105 =item billpkgnum
 106
 107 Sets/returns quotationpkgnum, for ease of integration with TemplateItem_Mixin::details
 108
 109 =cut
 110
 111 sub billpkgnum {
 112   my $self = shift;
 113   $self->quotationpkgnum(@_);
 114 }
 115
 116 =item insert
 117
 118 Adds this record to the database.  If there is an error, returns the error,
 119 otherwise returns false.
 120
 121 =cut
 122
 123 sub insert {
 124   my ($self, %options) = @_;
 125
 126   my $dbh = dbh;
 127   my $oldAutoCommit = $FS::UID::AutoCommit;
 128   local $FS::UID::AutoCommit = 0;
 129
 130   my $error = $self->SUPER::insert;
 131
 132   if ( !$error and $self->discountnum ) {
 133     $error = $self->insert_discount;
 134     $error .= ' (setting discount)' if $error;
 135   }
 136
 137   # update $self and any discounts with their amounts
 138   if ( !$error ) {
 139     $error = $self->estimate;
 140     $error .= ' (calculating charges)' if $error;
 141   }
 142
 143   if ( $error ) {
 144     $dbh->rollback if $oldAutoCommit;
 145     return $error;
 146   } else {
 147     $dbh->commit if $oldAutoCommit;
 148     return '';
 149   }
 150 }
 151
 152 =item delete
 153
 154 Delete this record from the database.
 155
 156 =cut
 157
 158 sub delete {
 159   my $self = shift;
 160
 161   my $dbh = dbh;
 162   my $oldAutoCommit = $FS::UID::AutoCommit;
 163   local $FS::UID::AutoCommit = 0;
 164
 165   my $error = $self->delete_details;
 166   if ( $error ) {
 167     $dbh->rollback if $oldAutoCommit;
 168     return $error;
 169   }
 170
 171   foreach ($self->quotation_pkg_discount, $self->quotation_pkg_tax) {
 172     $error = $_->delete;
 173     if ( $error ) {
 174       $dbh->rollback if $oldAutoCommit;
 175       return $error . ' (deleting discount)';
 176     }
 177   }
 178
 179   $error = $self->SUPER::delete;
 180   if ( $error ) {
 181     $dbh->rollback if $oldAutoCommit;
 182     return $error;
 183   } else {
 184     $dbh->commit if $oldAutoCommit;
 185     return '';
 186   }
 187
 188 }
 189
 190 =item replace OLD_RECORD
 191
 192 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 193 returns the error, otherwise returns false.
 194
 195 =item check
 196
 197 Checks all fields to make sure this is a valid quotation package.  If there is
 198 an error, returns the error, otherwise returns false.  Called by the insert
 199 and replace methods.
 200
 201 =cut
 202
 203 sub check {
 204   my $self = shift;
 205
 206   my $error =
 207     $self->ut_numbern('quotationpkgnum')
 208     || $self->ut_foreign_key(  'quotationnum', 'quotation',    'quotationnum' )
 209     || $self->ut_foreign_key(  'pkgpart',      'part_pkg',     'pkgpart'      )
 210     || $self->ut_foreign_keyn( 'locationnum', 'cust_location', 'locationnum'  )
 211     || $self->ut_numbern('start_date')
 212     || $self->ut_numbern('contract_end')
 213     || $self->ut_numbern('quantity')
 214     || $self->ut_moneyn('unitsetup')
 215     || $self->ut_moneyn('unitrecur')
 216     || $self->ut_enum('waive_setup', [ '', 'Y'] )
 217   ;
 218
 219   if ($self->locationnum eq '') {
 220     # use the customer default
 221     my $quotation = $self->quotation;
 222     if ($quotation->custnum) {
 223       $self->set('locationnum', $quotation->cust_main->ship_locationnum);
 224     } elsif ($quotation->prospectnum) {
 225       # use the first non-disabled location for that prospect
 226       my $cust_location = qsearchs('cust_location',
 227         { prospectnum => $quotation->prospectnum,
 228           disabled => '' });
 229       $self->set('locationnum', $cust_location->locationnum) if $cust_location;
 230     } # else the quotation is invalid
 231   }
 232
 233   return $error if $error;
 234
 235   $self->SUPER::check;
 236 }
 237
 238 sub part_pkg {
 239   my $self = shift;
 240   qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart } );
 241 }
 242
 243 sub desc {
 244   my $self = shift;
 245   $self->part_pkg->pkg;
 246 }
 247
 248 =item estimate
 249
 250 Update the quotation_pkg record with the estimated setup and recurring
 251 charges for the package. Returns nothing on success, or an error message
 252 on failure.
 253
 254 =cut
 255
 256 sub estimate {
 257   my $self = shift;
 258   my $part_pkg = $self->part_pkg;
 259   my $quantity = $self->quantity || 1;
 260   my ($unitsetup, $unitrecur);
 261   # calculate base fees
 262   if ( $self->waive_setup eq 'Y' || $self->{'_NO_SETUP_KLUDGE'} ) {
 263     $unitsetup = '0.00';
 264   } else {
 265     $unitsetup = $part_pkg->option('setup_fee',1) || '0.00'; # XXX 3.x only
 266   }
 267   if ( $self->{'_NO_RECUR_KLUDGE'} ) {
 268     $unitrecur = '0.00';
 269   } else {
 270     $unitrecur = $part_pkg->base_recur;
 271   }
 272
 273   #XXX add-on packages
 274
 275   $self->set('unitsetup', $unitsetup);
 276   $self->set('unitrecur', $unitrecur);
 277   my $error = $self->replace;
 278   return $error if $error;
 279
 280   # semi-duplicates calc_discount
 281   my $setup_discount = 0;
 282   my $recur_discount = 0;
 283
 284   my %setup_discounts; # quotationpkgdiscountnum => amount
 285   my %recur_discounts; # quotationpkgdiscountnum => amount
 286
 287   # XXX the order of applying discounts is ill-defined, which matters
 288   # if there are percentage and amount discounts on the same package.
 289   #
 290   # but right now there can only be one discount on any package, so
 291   # it doesn't matter
 292   foreach my $pkg_discount ($self->quotation_pkg_discount) {
 293
 294     my $discount = $pkg_discount->discount;
 295     my $this_setup_discount = 0;
 296     my $this_recur_discount = 0;
 297
 298     if ( $discount->percent > 0 ) {
 299
 300       if ( $discount->setup ) {
 301         $this_setup_discount = ($discount->percent * $unitsetup / 100);
 302       }
 303       $this_recur_discount = ($discount->percent * $unitrecur / 100);
 304
 305     } elsif ( $discount->amount > 0 ) {
 306
 307       my $discount_left = $discount->amount;
 308       if ( $discount->setup ) {
 309         if ( $discount_left > $unitsetup - $setup_discount ) {
 310           # then discount the setup to zero
 311           $discount_left -= $unitsetup - $setup_discount;
 312           $this_setup_discount = $unitsetup - $setup_discount;
 313         } else {
 314           # not enough discount to fully cover the setup
 315           $this_setup_discount = $discount_left;
 316           $discount_left = 0;
 317         }
 318       }
 319       # same logic for recur
 320       if ( $discount_left > $unitrecur - $recur_discount ) {
 321         $this_recur_discount = $unitrecur - $recur_discount;
 322       } else {
 323         $this_recur_discount = $discount_left;
 324       }
 325
 326     }
 327
 328     # increment the total discountage
 329     $setup_discount += $this_setup_discount;
 330     $recur_discount += $this_recur_discount;
 331     # and update the pkg_discount object
 332     $pkg_discount->set('setup_amount', sprintf('%.2f', $setup_discount));
 333     $pkg_discount->set('recur_amount', sprintf('%.2f', $recur_discount));
 334     my $error = $pkg_discount->replace;
 335     return $error if $error;
 336   }
 337
 338   '';
 339 }
 340
 341 =item insert_discount
 342
 343 Associates this package with a discount (see L<FS::cust_pkg_discount>,
 344 possibly inserting a new discount on the fly (see L<FS::discount>). Properties
 345 of the discount will be taken from this object.
 346
 347 =cut
 348
 349 sub insert_discount {
 350   #my ($self, %options) = @_;
 351   my $self = shift;
 352
 353   my $quotation_pkg_discount = FS::quotation_pkg_discount->new( {
 354     'quotationpkgnum' => $self->quotationpkgnum,
 355     'discountnum'     => $self->discountnum,
 356     #for the create a new discount case
 357     '_type'           => $self->discountnum__type,
 358     'amount'      => $self->discountnum_amount,
 359     'percent'     => $self->discountnum_percent,
 360     'months'      => $self->discountnum_months,
 361     'setup'       => $self->discountnum_setup,
 362   } );
 363
 364   $quotation_pkg_discount->insert;
 365 }
 366
 367 sub _item_discount {
 368   my $self = shift;
 369   my @pkg_discounts = $self->pkg_discount;
 370   return if @pkg_discounts == 0;
 371
 372   my @ext;
 373   my $d = {
 374     _is_discount    => 1,
 375     description     => $self->mt('Discount'),
 376     setup_amount    => 0,
 377     recur_amount    => 0,
 378     amount          => 0,
 379     ext_description => \@ext,
 380     # maybe should show quantity/unit discount?
 381   };
 382   foreach my $pkg_discount (@pkg_discounts) {
 383     push @ext, $pkg_discount->description;
 384     $d->{setup_amount} -= $pkg_discount->setup_amount;
 385     $d->{recur_amount} -= $pkg_discount->recur_amount;
 386   }
 387   $d->{setup_amount} *= $self->quantity || 1;
 388   $d->{recur_amount} *= $self->quantity || 1;
 389   $d->{amount} = $d->{setup_amount} + $d->{recur_amount};
 390
 391   return $d;
 392 }
 393
 394 sub setup {
 395   my $self = shift;
 396   ($self->unitsetup - sum(0, map { $_->setup_amount } $self->pkg_discount))
 397     * ($self->quantity || 1);
 398 }
 399
 400 sub recur {
 401   my $self = shift;
 402   ($self->unitrecur - sum(0, map { $_->recur_amount } $self->pkg_discount))
 403     * ($self->quantity || 1);
 404 }
 405
 406 =item delete_details
 407
 408 Deletes all quotation_pkgs_details associated with this pkg (see L<FS::quotation_pkg_detail>).
 409
 410 =cut
 411
 412 sub delete_details {
 413   my $self = shift;
 414
 415   my $oldAutoCommit = $FS::UID::AutoCommit;
 416   local $FS::UID::AutoCommit = 0;
 417   my $dbh = dbh;
 418
 419   foreach my $detail ( qsearch('quotation_pkg_detail',{ 'billpkgnum' => $self->quotationpkgnum }) ) {
 420     my $error = $detail->delete;
 421     if ( $error ) {
 422       $dbh->rollback if $oldAutoCommit;
 423       return "error removing old detail: $error";
 424     }
 425   }
 426
 427   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 428   '';
 429
 430 }
 431
 432 =item set_details [ DETAIL, DETAIL, ... ]
 433
 434 Sets quotation details for this package (see L<FS::quotation_pkg_detail>).
 435
 436 If there is an error, returns the error, otherwise returns false.
 437
 438 =cut
 439
 440 sub set_details {
 441   my( $self, @details ) = @_;
 442
 443   my $oldAutoCommit = $FS::UID::AutoCommit;
 444   local $FS::UID::AutoCommit = 0;
 445   my $dbh = dbh;
 446
 447   my $error = $self->delete_details;
 448   if ( $error ) {
 449     $dbh->rollback if $oldAutoCommit;
 450     return $error;
 451   }
 452
 453   foreach my $detail ( @details ) {
 454     my $quotation_pkg_detail = new FS::quotation_pkg_detail {
 455       'billpkgnum' => $self->quotationpkgnum,
 456       'detail'     => $detail,
 457     };
 458     $error = $quotation_pkg_detail->insert;
 459     if ( $error ) {
 460       $dbh->rollback if $oldAutoCommit;
 461       return "error adding new detail: $error";
 462     }
 463   }
 464
 465   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 466   '';
 467
 468 }
 469
 470 =item cust_bill_pkg_display [ type => TYPE ]
 471
 472 =cut
 473
 474 sub cust_bill_pkg_display {
 475   my ( $self, %opt ) = @_;
 476
 477   my $type = $opt{type} if exists $opt{type};
 478   return () if $type eq 'U'; #quotations don't have usage
 479
 480   if ( $self->get('display') ) {
 481     return ( grep { defined($type) ? ($type eq $_->type) : 1 }
 482                @{ $self->get('display') }
 483            );
 484   } else {
 485
 486     #??
 487     my $setup = $self->new($self->hashref);
 488     $setup->{'_NO_RECUR_KLUDGE'} = 1;
 489     $setup->{'type'} = 'S';
 490     my $recur = $self->new($self->hashref);
 491     $recur->{'_NO_SETUP_KLUDGE'} = 1;
 492     $recur->{'type'} = 'R';
 493
 494     if ( $type eq 'S' ) {
 495       return ($setup);
 496     } elsif ( $type eq 'R' ) {
 497       return ($recur);
 498     } else {
 499       #return ($setup, $recur);
 500       return ($self);
 501     }
 502
 503   }
 504
 505 }
 506
 507 =item cust_main
 508
 509 Returns the customer (L<FS::cust_main> object).
 510
 511 =cut
 512
 513 sub cust_main {
 514   my $self = shift;
 515   my $quotation = FS::quotation->by_key($self->quotationnum) or return '';
 516   $quotation->cust_main;
 517 }
 518
 519 sub tax_locationnum {
 520   my $self = shift;
 521   $self->locationnum;
 522 }
 523
 524 #stub for 3.x
 525
 526 sub quotation {
 527   my $self = shift;
 528   FS::quotation->by_key($self->quotationnum);
 529 }
 530
 531 sub quotation_pkg_discount {
 532   my $self = shift;
 533   qsearch('quotation_pkg_discount', { quotationpkgnum => $self->quotationpkgnum });
 534 }
 535
 536 sub quotation_pkg_tax {
 537   my $self = shift;
 538   qsearch('quotation_pkg_tax', { quotationpkgnum => $self->quotationpkgnum });
 539 }
 540
 541 sub cust_location {
 542   my $self = shift;
 543   $self->locationnum ? qsearchs('cust_location', { locationnum => $self->locationnum }) : '';
 544 }
 545
 546
 547 sub _upgrade_data {
 548   my $class = shift;
 549   my @quotation_pkg_without_location =
 550     qsearch( 'quotation_pkg', { locationnum => '' } );
 551   if (@quotation_pkg_without_location) {
 552     warn "setting default location on quotation_pkg records\n";
 553     foreach my $quotation_pkg (@quotation_pkg_without_location) {
 554       # check() will fix this
 555       my $error = $quotation_pkg->replace;
 556       if ($error) {
 557         die "quotation #".$quotation_pkg->quotationnum.": $error\n";
 558       }
 559     }
 560   }
 561   '';
 562 }
 563
 564 =back
 565
 566 =head1 BUGS
 567
 568 Doesn't support fees, or add-on packages.
 569
 570 =head1 SEE ALSO
 571
 572 L<FS::Record>, schema.html from the base documentation.
 573
 574 =cut
 575
 576 1;
 577