FS/FS/quotation_pkg.pm

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