2 use base qw( FS::part_pkg::API
3 FS::m2m_Common FS::o2m_Common FS::option_Common
7 use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack
8 $cache_enabled %cache_link %cache_pkg_svc
10 use Carp qw(carp cluck confess);
11 use Scalar::Util qw( blessed );
13 use Time::Local qw( timelocal timelocal_nocheck ); # eventually replace with DateTime
16 use FS::Record qw( qsearch qsearchs dbh dbdef );
17 use FS::Cursor; # for upgrade
23 use FS::part_pkg_option;
24 use FS::part_pkg_fcc_option;
27 use FS::part_pkg_msgcat;
28 use FS::part_pkg_taxrate;
29 use FS::part_pkg_taxoverride;
30 use FS::part_pkg_taxproduct;
31 use FS::part_pkg_link;
32 use FS::part_pkg_discount;
33 use FS::part_pkg_vendor;
34 use FS::part_pkg_currency;
35 use FS::part_svc_link;
40 $skip_pkg_svc_hack = 0;
48 FS::part_pkg - Object methods for part_pkg objects
54 $record = new FS::part_pkg \%hash
55 $record = new FS::part_pkg { 'column' => 'value' };
57 $custom_record = $template_record->clone;
59 $error = $record->insert;
61 $error = $new_record->replace($old_record);
63 $error = $record->delete;
65 $error = $record->check;
67 @pkg_svc = $record->pkg_svc;
69 $svcnum = $record->svcpart;
70 $svcnum = $record->svcpart( 'svc_acct' );
74 An FS::part_pkg object represents a package definition. FS::part_pkg
75 inherits from FS::Record. The following fields are currently supported:
79 =item pkgpart - primary key (assigned automatically for new package definitions)
81 =item pkg - Text name of this package definition (customer-viewable)
83 =item comment - Text name of this package definition (non-customer-viewable)
85 =item classnum - Optional package class (see L<FS::pkg_class>)
87 =item promo_code - Promotional code
89 =item setup - Setup fee expression (deprecated)
91 =item freq - Frequency of recurring fee
93 =item recur - Recurring fee expression (deprecated)
95 =item setuptax - Setup fee tax exempt flag, empty or `Y'
97 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
99 =item taxclass - Tax class
101 =item plan - Price plan
103 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
105 =item disabled - Disabled flag, empty or `Y'
107 =item custom - Custom flag, empty or `Y'
109 =item setup_cost - for cost tracking
111 =item recur_cost - for cost tracking
113 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
115 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
117 =item agentnum - Optional agentnum (see L<FS::agent>)
119 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
121 =item fcc_voip_class - Which column of FCC form 477 part II.B this package
124 =item successor - Foreign key for the part_pkg that replaced this record.
125 If this record is not obsolete, will be null.
127 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
128 ancestor of this record. If this record is not a successor to another
129 part_pkg, will be equal to pkgpart.
131 =item delay_start - Number of days to delay package start, by default
133 =item start_on_hold - 'Y' to suspend this package immediately when it is
134 ordered. The package will not start billing or have a setup fee charged
135 until it is manually unsuspended.
137 =item change_to_pkgpart - When this package is ordered, schedule a future
138 package change. The 'expire_months' field will determine when the package
141 =item expire_months - Number of months until this package expires (or changes
144 =item adjourn_months - Number of months until this package becomes suspended.
146 =item contract_end_months - Number of months until the package's contract
157 Creates a new package definition. To add the package definition to
158 the database, see L<"insert">.
162 sub table { 'part_pkg'; }
166 An alternate constructor. Creates a new package definition by duplicating
167 an existing definition. A new pkgpart is assigned and the custom flag is
168 set to Y. To add the package definition to the database, see L<"insert">.
174 my $class = ref($self);
175 my %hash = $self->hash;
176 $hash{'pkgpart'} = '';
177 $hash{'custom'} = 'Y';
178 #new FS::part_pkg ( \%hash ); # ?
179 new $class ( \%hash ); # ?
182 =item insert [ , OPTION => VALUE ... ]
184 Adds this package definition to the database. If there is an error,
185 returns the error, otherwise returns false.
187 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
188 I<custnum_ref> and I<options>.
190 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
191 values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
192 be set to a hashref of svcparts and flag values ('Y' or '') to set the
193 'hidden' field in these records, and I<provision_hold> can be set similarly
194 for the 'provision_hold' field in these records.
196 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
197 FS::pkg_svc record will be updated.
199 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
200 record itself), the object will be updated to point to this package definition.
202 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
203 the scalar will be updated with the custnum value from the cust_pkg record.
205 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
206 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
207 records will be inserted.
209 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
210 records will be inserted.
212 If I<part_pkg_currency> is set to a hashref of options (with the keys as
213 option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted.
220 warn "FS::part_pkg::insert called on $self with options ".
221 join(', ', map "$_=>$options{$_}", keys %options)
224 local $SIG{HUP} = 'IGNORE';
225 local $SIG{INT} = 'IGNORE';
226 local $SIG{QUIT} = 'IGNORE';
227 local $SIG{TERM} = 'IGNORE';
228 local $SIG{TSTP} = 'IGNORE';
229 local $SIG{PIPE} = 'IGNORE';
231 my $oldAutoCommit = $FS::UID::AutoCommit;
232 local $FS::UID::AutoCommit = 0;
235 if ( length($self->classnum) && $self->classnum !~ /^(\d+)$/ ) {
236 my $pkg_class = qsearchs('pkg_class', { 'classname' => $self->classnum } )
237 || new FS::pkg_class { classname => $self->classnum };
238 unless ( $pkg_class->classnum ) {
239 my $error = $pkg_class->insert;
241 $dbh->rollback if $oldAutoCommit;
245 $self->classnum( $pkg_class->classnum );
248 warn " inserting part_pkg record" if $DEBUG;
249 my $error = $self->SUPER::insert( $options{options} );
251 $dbh->rollback if $oldAutoCommit;
256 if ( $self->get('family_pkgpart') eq '' ) {
257 $self->set('family_pkgpart' => $self->pkgpart);
258 $error = $self->SUPER::replace;
260 $dbh->rollback if $oldAutoCommit;
265 warn " inserting part_pkg_taxoverride records" if $DEBUG;
266 my %overrides = %{ $options{'tax_overrides'} || {} };
267 foreach my $usage_class ( keys %overrides ) {
269 ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
270 ? $overrides{$usage_class}
272 my @overrides = (grep "$_", split(',', $override) );
273 my $error = $self->process_m2m (
274 'link_table' => 'part_pkg_taxoverride',
275 'target_table' => 'tax_class',
276 'hashref' => { 'usage_class' => $usage_class },
277 'params' => \@overrides,
280 $dbh->rollback if $oldAutoCommit;
285 warn " inserting part_pkg_currency records" if $DEBUG;
286 my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} };
287 foreach my $key ( keys %part_pkg_currency ) {
288 $key =~ /^(.+)_([A-Z]{3})$/ or next;
289 my( $optionname, $currency ) = ( $1, $2 );
290 if ( $part_pkg_currency{$key} =~ /^\s*$/ ) {
291 if ( $self->option($optionname) == 0 ) {
292 $part_pkg_currency{$key} = '0';
294 $dbh->rollback if $oldAutoCommit;
295 ( my $thing = $optionname ) =~ s/_/ /g;
296 return ucfirst($thing). " $currency is required";
299 my $part_pkg_currency = new FS::part_pkg_currency {
300 'pkgpart' => $self->pkgpart,
301 'optionname' => $optionname,
302 'currency' => $currency,
303 'optionvalue' => $part_pkg_currency{$key},
305 my $error = $part_pkg_currency->insert;
307 $dbh->rollback if $oldAutoCommit;
312 unless ( $skip_pkg_svc_hack ) {
314 warn " inserting pkg_svc records" if $DEBUG;
315 my $pkg_svc = $options{'pkg_svc'} || {};
316 my $hidden_svc = $options{'hidden_svc'} || {};
317 my $provision_hold = $options{'provision_hold'} || {};
318 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
319 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
321 ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
325 my $pkg_svc = new FS::pkg_svc( {
326 'pkgpart' => $self->pkgpart,
327 'svcpart' => $part_svc->svcpart,
328 'quantity' => $quantity,
329 'primary_svc' => $primary_svc,
330 'hidden' => $hidden_svc->{$part_svc->svcpart},
331 'provision_hold' => $provision_hold->{$part_svc->svcpart},
333 my $error = $pkg_svc->insert;
335 $dbh->rollback if $oldAutoCommit;
340 my $error = $self->check_pkg_svc(%options);
342 $dbh->rollback if $oldAutoCommit;
348 if ( $options{'cust_pkg'} ) {
349 warn " updating cust_pkg record " if $DEBUG;
351 ref($options{'cust_pkg'})
352 ? $options{'cust_pkg'}
353 : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
354 ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
355 if $options{'custnum_ref'};
356 my %hash = $old_cust_pkg->hash;
357 $hash{'pkgpart'} = $self->pkgpart,
358 my $new_cust_pkg = new FS::cust_pkg \%hash;
359 local($FS::cust_pkg::disable_agentcheck) = 1;
360 my $error = $new_cust_pkg->replace($old_cust_pkg);
362 $dbh->rollback if $oldAutoCommit;
363 return "Error modifying cust_pkg record: $error";
367 if ( $options{'part_pkg_vendor'} ) {
368 while ( my ($exportnum, $vendor_pkg_id) =
369 each %{ $options{part_pkg_vendor} }
372 my $ppv = new FS::part_pkg_vendor( {
373 'pkgpart' => $self->pkgpart,
374 'exportnum' => $exportnum,
375 'vendor_pkg_id' => $vendor_pkg_id,
377 my $error = $ppv->insert;
379 $dbh->rollback if $oldAutoCommit;
380 return "Error inserting part_pkg_vendor record: $error";
385 if ( $options{fcc_options} ) {
386 warn " updating fcc options " if $DEBUG;
387 $self->set_fcc_options( $options{fcc_options} );
390 warn " committing transaction" if $DEBUG and $oldAutoCommit;
391 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
398 Currently unimplemented.
403 return "Can't (yet?) delete package definitions.";
404 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
407 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
409 Replaces OLD_RECORD with this one in the database. If there is an error,
410 returns the error, otherwise returns false.
412 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>,
413 I<bulk_skip>, I<provision_hold> and I<options>
415 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
416 values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
417 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
418 'hidden' field in these records. I<bulk_skip> and I<provision_hold> can be
419 set to a hashref of svcparts and flag values ('Y' or '') to set the
420 respective field in those records.
422 If I<primary_svc> is set to the svcpart of the primary service, the
423 appropriate FS::pkg_svc record will be updated.
425 If I<options> is set to a hashref, the appropriate FS::part_pkg_option
426 records will be replaced.
428 If I<part_pkg_currency> is set to a hashref of options (with the keys as
429 option_CURRENCY), appropriate FS::part_pkg::currency records will be
437 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
442 ( ref($_[0]) eq 'HASH' )
446 $options->{options} = { $old->options } unless defined($options->{options});
448 warn "FS::part_pkg::replace called on $new to replace $old with options".
449 join(', ', map "$_ => ". $options->{$_}, keys %$options)
452 local $SIG{HUP} = 'IGNORE';
453 local $SIG{INT} = 'IGNORE';
454 local $SIG{QUIT} = 'IGNORE';
455 local $SIG{TERM} = 'IGNORE';
456 local $SIG{TSTP} = 'IGNORE';
457 local $SIG{PIPE} = 'IGNORE';
459 my $oldAutoCommit = $FS::UID::AutoCommit;
460 local $FS::UID::AutoCommit = 0;
463 my $conf = new FS::Conf;
464 if ( $conf->exists('part_pkg-lineage') ) {
465 if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
466 qw(setup_fee recur_fee) #others? config?
469 warn " superseding package" if $DEBUG;
471 my $error = $new->supersede($old, %$options);
473 $dbh->rollback if $oldAutoCommit;
477 warn " committing transaction" if $DEBUG and $oldAutoCommit;
478 $dbh->commit if $oldAutoCommit;
485 #plandata shit stays in replace for upgrades until after 2.0 (or edit
487 warn " saving legacy plandata" if $DEBUG;
488 my $plandata = $new->get('plandata');
489 $new->set('plandata', '');
491 warn " deleting old part_pkg_option records" if $DEBUG;
492 foreach my $part_pkg_option ( $old->part_pkg_option ) {
493 my $error = $part_pkg_option->delete;
495 $dbh->rollback if $oldAutoCommit;
500 warn " replacing part_pkg record" if $DEBUG;
501 my $error = $new->SUPER::replace($old, $options->{options} );
503 $dbh->rollback if $oldAutoCommit;
507 warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
508 foreach my $part_pkg_option (
509 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
510 return "illegal plandata: $plandata";
512 new FS::part_pkg_option {
513 'pkgpart' => $new->pkgpart,
518 split("\n", $plandata)
520 my $error = $part_pkg_option->insert;
522 $dbh->rollback if $oldAutoCommit;
527 #trivial nit: not the most efficient to delete and reinsert
528 warn " deleting old part_pkg_currency records" if $DEBUG;
529 foreach my $part_pkg_currency ( $old->part_pkg_currency ) {
530 my $error = $part_pkg_currency->delete;
532 $dbh->rollback if $oldAutoCommit;
533 return "error deleting part_pkg_currency record: $error";
537 warn " inserting new part_pkg_currency records" if $DEBUG;
538 my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} };
539 foreach my $key ( keys %part_pkg_currency ) {
540 $key =~ /^(.+)_([A-Z]{3})$/ or next;
541 my $part_pkg_currency = new FS::part_pkg_currency {
542 'pkgpart' => $new->pkgpart,
545 'optionvalue' => $part_pkg_currency{$key},
547 my $error = $part_pkg_currency->insert;
549 $dbh->rollback if $oldAutoCommit;
550 return "error inserting part_pkg_currency record: $error";
555 warn " replacing pkg_svc records" if $DEBUG;
556 my $pkg_svc = $options->{'pkg_svc'};
557 my $hidden_svc = $options->{'hidden_svc'} || {};
558 my $bulk_skip = $options->{'bulk_skip'} || {};
559 my $provision_hold = $options->{'provision_hold'} || {};
560 if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
562 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
563 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
564 my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
565 my $bulk_skip = $bulk_skip->{$part_svc->svcpart} || '';
566 my $provision_hold = $provision_hold->{$part_svc->svcpart} || '';
568 ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
569 && $options->{'primary_svc'} == $part_svc->svcpart
574 my $old_pkg_svc = qsearchs('pkg_svc', {
575 'pkgpart' => $old->pkgpart,
576 'svcpart' => $part_svc->svcpart,
579 my $old_quantity = 0;
580 my $old_primary_svc = '';
582 my $old_bulk_skip = '';
583 my $old_provision_hold = '';
584 if ( $old_pkg_svc ) {
585 $old_quantity = $old_pkg_svc->quantity;
586 $old_primary_svc = $old_pkg_svc->primary_svc
587 if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
588 $old_hidden = $old_pkg_svc->hidden;
589 $old_bulk_skip = $old_pkg_svc->old_bulk_skip; # should this just be bulk_skip?
590 $old_provision_hold = $old_pkg_svc->provision_hold;
593 next unless $old_quantity != $quantity
594 || $old_primary_svc ne $primary_svc
595 || $old_hidden ne $hidden
596 || $old_bulk_skip ne $bulk_skip
597 || $old_provision_hold ne $provision_hold;
599 my $new_pkg_svc = new FS::pkg_svc( {
600 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
601 'pkgpart' => $new->pkgpart,
602 'svcpart' => $part_svc->svcpart,
603 'quantity' => $quantity,
604 'primary_svc' => $primary_svc,
606 'bulk_skip' => $bulk_skip,
607 'provision_hold' => $provision_hold,
609 my $error = $old_pkg_svc
610 ? $new_pkg_svc->replace($old_pkg_svc)
611 : $new_pkg_svc->insert;
613 $dbh->rollback if $oldAutoCommit;
618 my $error = $new->check_pkg_svc(%$options);
620 $dbh->rollback if $oldAutoCommit;
624 } #if $options->{pkg_svc}
626 my @part_pkg_vendor = $old->part_pkg_vendor;
627 my @current_exportnum = ();
628 if ( $options->{'part_pkg_vendor'} ) {
629 my($exportnum,$vendor_pkg_id);
630 while ( ($exportnum,$vendor_pkg_id)
631 = each %{$options->{'part_pkg_vendor'}} ) {
633 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
634 if($exportnum == $part_pkg_vendor->exportnum
635 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
636 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
637 my $error = $part_pkg_vendor->replace;
639 $dbh->rollback if $oldAutoCommit;
640 return "Error replacing part_pkg_vendor record: $error";
645 elsif($exportnum == $part_pkg_vendor->exportnum
646 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
651 unless ( $noinsert ) {
652 my $ppv = new FS::part_pkg_vendor( {
653 'pkgpart' => $new->pkgpart,
654 'exportnum' => $exportnum,
655 'vendor_pkg_id' => $vendor_pkg_id,
657 my $error = $ppv->insert;
659 $dbh->rollback if $oldAutoCommit;
660 return "Error inserting part_pkg_vendor record: $error";
663 push @current_exportnum, $exportnum;
666 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
667 unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
668 my $error = $part_pkg_vendor->delete;
670 $dbh->rollback if $oldAutoCommit;
671 return "Error deleting part_pkg_vendor record: $error";
676 # propagate changes to certain core fields
677 if ( $conf->exists('part_pkg-lineage') ) {
678 warn " propagating changes to family" if $DEBUG;
679 my $error = $new->propagate($old);
681 $dbh->rollback if $oldAutoCommit;
686 if ( $options->{fcc_options} ) {
687 warn " updating fcc options " if $DEBUG;
688 $new->set_fcc_options( $options->{fcc_options} );
691 warn " committing transaction" if $DEBUG and $oldAutoCommit;
692 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
698 Checks all fields to make sure this is a valid package definition. If
699 there is an error, returns the error, otherwise returns false. Called by the
700 insert and replace methods.
706 warn "FS::part_pkg::check called on $self" if $DEBUG;
708 for (qw(setup recur plandata)) {
709 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
710 return "Use of $_ field is deprecated; set a plan and options: ".
712 if length($self->get($_));
716 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
717 my $error = $self->ut_number('freq');
718 return $error if $error;
720 $self->freq =~ /^(\d+[hdw]?)$/
721 or return "Illegal or empty freq: ". $self->freq;
725 my @null_agentnum_right = ( 'Edit global package definitions' );
726 push @null_agentnum_right, 'One-time charge'
727 if $self->freq =~ /^0/;
728 push @null_agentnum_right, 'Customize customer package'
729 if $self->disabled eq 'Y'; #good enough
731 my $error = $self->ut_numbern('pkgpart')
732 || $self->ut_text('pkg')
733 || $self->ut_textn('comment')
734 || $self->ut_textn('promo_code')
735 || $self->ut_alphan('plan')
736 || $self->ut_flag('setuptax')
737 || $self->ut_flag('recurtax')
738 || $self->ut_textn('taxclass')
739 || $self->ut_flag('disabled')
740 || $self->ut_flag('custom')
741 || $self->ut_flag('no_auto')
742 || $self->ut_flag('recur_show_zero')
743 || $self->ut_flag('setup_show_zero')
744 || $self->ut_flag('start_on_hold')
745 #|| $self->ut_moneyn('setup_cost')
746 #|| $self->ut_moneyn('recur_cost')
747 || $self->ut_floatn('setup_cost')
748 || $self->ut_floatn('recur_cost')
749 || $self->ut_floatn('pay_weight')
750 || $self->ut_floatn('credit_weight')
751 || $self->ut_numbern('taxproductnum')
752 || $self->ut_numbern('units_taxproductnum')
753 || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
754 || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
755 || $self->ut_foreign_keyn('taxproductnum',
756 'part_pkg_taxproduct',
760 ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
761 : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
763 || $self->ut_numbern('fcc_ds0s')
764 || $self->ut_numbern('fcc_voip_class')
765 || $self->ut_numbern('delay_start')
766 || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
767 || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
768 || $self->ut_numbern('expire_months')
769 || $self->ut_numbern('adjourn_months')
770 || $self->ut_numbern('contract_end_months')
771 || $self->ut_numbern('change_to_pkgpart')
772 || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
773 || $self->ut_alphan('agent_pkgpartid')
774 || $self->SUPER::check
776 return $error if $error;
778 return 'Unknown plan '. $self->plan
779 unless exists($plans{$self->plan});
781 my $conf = new FS::Conf;
782 return 'Taxclass is required'
783 if ! $self->taxclass && $conf->exists('require_taxclasses');
790 For a passed I<$options> hashref, validates any options that
791 have 'validate' subroutines defined in the info hash,
792 then validates the entire hashref if the price plan has
793 its own 'validate' subroutine defined in the info hash
794 (I<$options> values might be altered.)
796 Returns error message, or empty string if valid.
798 Invoked by L</insert> and L</replace> via the equivalent
799 methods in L<FS::option_Common>.
804 my ($self,$options) = @_;
805 foreach my $option (keys %$options) {
806 if (exists $plans{ $self->plan }->{fields}->{$option}) {
807 if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) {
808 # pass option name for use in error message
809 # pass a reference to the $options value, so it can be cleaned up
810 my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option}));
811 return $error if $error;
813 } # else "option does not exist" error?
815 if (exists($plans{$self->plan}->{'validate'})) {
816 my $error = &{$plans{$self->plan}->{'validate'}}($options);
817 return $error if $error;
824 Checks pkg_svc records as a whole (for part_svc_link dependencies).
826 If there is an error, returns the error, otherwise returns false.
831 my( $self, %opt ) = @_;
833 my $agentnum = $self->agentnum;
835 my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
837 foreach my $svcpart ( keys %pkg_svc ) {
839 foreach my $part_svc_link ( $self->part_svc_link(
840 'src_svcpart' => $svcpart,
841 'link_type' => 'part_pkg_restrict',
845 return $part_svc_link->dst_svc. ' must be included with '.
846 $part_svc_link->src_svc
847 unless $pkg_svc{ $part_svc_link->dst_svcpart };
852 return '' if $opt{part_pkg_restrict_soft_override};
854 foreach my $svcpart ( keys %pkg_svc ) {
856 foreach my $part_svc_link ( $self->part_svc_link(
857 'src_svcpart' => $svcpart,
858 'link_type' => 'part_pkg_restrict_soft',
861 return $part_svc_link->dst_svc. ' is suggested with '.
862 $part_svc_link->src_svc
863 unless $pkg_svc{ $part_svc_link->dst_svcpart };
871 =item part_svc_link OPTION => VALUE ...
873 Returns the service dependencies (see L<FS::part_svc_link>) for the given
874 search options, taking into account this package definition's agent.
876 Available options are any field in part_svc_link. Typically used options are
877 src_svcpart and link_type.
882 FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
885 =item supersede OLD [, OPTION => VALUE ... ]
887 Inserts this package as a successor to the package OLD. All options are as
888 for C<insert>. After inserting, disables OLD and sets the new package as its
894 my ($new, $old, %options) = @_;
897 $new->set('pkgpart' => '');
898 $new->set('family_pkgpart' => $old->family_pkgpart);
899 warn " inserting successor package\n" if $DEBUG;
900 $error = $new->insert(%options);
901 return $error if $error;
903 warn " disabling superseded package\n" if $DEBUG;
904 $old->set('successor' => $new->pkgpart);
905 $old->set('disabled' => 'Y');
906 $error = $old->SUPER::replace; # don't change its options/pkg_svc records
907 return $error if $error;
909 warn " propagating changes to family" if $DEBUG;
910 $new->propagate($old);
915 If any of certain fields have changed from OLD to this package, then,
916 for all packages in the same lineage as this one, sets those fields
917 to their values in this package.
921 my @propagate_fields = (
922 qw( pkg classnum setup_cost recur_cost taxclass
923 setuptax recurtax pay_weight credit_weight
931 map { $_ => $new->get($_) }
932 grep { $new->get($_) ne $old->get($_) }
936 my @part_pkg = qsearch('part_pkg', {
937 'family_pkgpart' => $new->family_pkgpart
940 foreach my $part_pkg ( @part_pkg ) {
941 my $pkgpart = $part_pkg->pkgpart;
942 next if $pkgpart == $new->pkgpart; # don't modify $new
943 warn " propagating to pkgpart $pkgpart\n" if $DEBUG;
944 foreach ( keys %fields ) {
945 $part_pkg->set($_, $fields{$_});
947 # SUPER::replace to avoid changing non-core fields
948 my $error = $part_pkg->SUPER::replace;
949 push @error, "pkgpart $pkgpart: $error"
955 =item set_fcc_options HASHREF
957 Sets the FCC options on this package definition to the values specified
962 sub set_fcc_options {
964 my $pkgpart = $self->pkgpart;
972 my %existing_num = map { $_->fccoptionname => $_->num }
973 qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
975 local $FS::Record::nowarn_identical = 1;
976 # set up params for process_o2m
979 foreach my $name (keys %$options ) {
980 $params->{ "num$i" } = $existing_num{$name} || '';
981 $params->{ "num$i".'_fccoptionname' } = $name;
982 $params->{ "num$i".'_optionvalue' } = $options->{$name};
987 table => 'part_pkg_fcc_option',
988 fields => [qw( fccoptionname optionvalue )],
993 =item pkg_locale LOCALE
995 Returns a customer-viewable string representing this package for the given
996 locale, from the part_pkg_msgcat table. If the given locale is empty or no
997 localized string is found, returns the base pkg field.
1002 my( $self, $locale ) = @_;
1003 return $self->pkg unless $locale;
1004 my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
1005 $part_pkg_msgcat->pkg;
1008 =item part_pkg_msgcat LOCALE
1010 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
1014 sub part_pkg_msgcat {
1015 my( $self, $locale ) = @_;
1016 qsearchs( 'part_pkg_msgcat', {
1017 pkgpart => $self->pkgpart,
1022 =item pkg_comment [ OPTION => VALUE... ]
1024 Returns an (internal) string representing this package. Currently,
1025 "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
1026 future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
1029 If the option nopkgpart is true then the "pkgpart: ' is omitted.
1037 #$self->pkg. ' - '. $self->comment;
1038 #$self->pkg. ' ('. $self->comment. ')';
1039 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1040 my $custom_comment = $self->custom_comment(%opt);
1041 $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
1044 #without price info (so without hitting the DB again)
1045 sub pkg_comment_only {
1049 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
1050 my $comment = $self->comment;
1051 $pre. $self->pkg. ( $comment ? " - $comment" : '' );
1054 sub price_info { # safety, in case a part_pkg hasn't defined price_info
1058 sub custom_comment {
1060 my $price_info = $self->price_info(@_);
1061 ( $self->custom ? '(CUSTOM) ' : '' ).
1063 ( ($self->custom || $self->comment) ? ' - ' : '' ).
1064 ($price_info || 'No charge');
1067 sub pkg_price_info {
1069 $self->pkg. ' - '. ($self->price_info || 'No charge');
1074 Returns the package class, as an FS::pkg_class object, or the empty string
1075 if there is no package class.
1077 =item addon_pkg_class
1079 Returns the add-on package class, as an FS::pkg_class object, or the empty
1080 string if there is no add-on package class.
1084 sub addon_pkg_class {
1086 if ( $self->addon_classnum ) {
1087 qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
1095 Returns the package category name, or the empty string if there is no package
1102 my $pkg_class = $self->pkg_class;
1104 ? $pkg_class->categoryname
1110 Returns the package class name, or the empty string if there is no package
1117 my $pkg_class = $self->pkg_class;
1119 ? $pkg_class->classname
1123 =item addon_classname
1125 Returns the add-on package class name, or the empty string if there is no
1126 add-on package class.
1130 sub addon_classname {
1132 my $pkg_class = $self->addon_pkg_class;
1134 ? $pkg_class->classname
1140 Returns the associated agent for this event, if any, as an FS::agent object.
1142 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1144 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1145 definition (with non-zero quantity).
1147 One option is available, I<disable_linked>. If set true it will return the
1148 services for this package definition alone, omitting services from any add-on
1155 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1163 return @{ $cache_pkg_svc{$self->pkgpart} }
1164 if $cache_enabled && $cache_pkg_svc{$self->pkgpart};
1166 # #sort { $b->primary cmp $a->primary }
1167 # grep { $_->quantity }
1168 # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1170 my $opt = ref($_[0]) ? $_[0] : { @_ };
1171 my %pkg_svc = map { $_->svcpart => $_ } $self->_pkg_svc;
1173 unless ( $opt->{disable_linked} ) {
1174 foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1175 my @pkg_svc = $dst_pkg->_pkg_svc;
1176 foreach my $pkg_svc ( @pkg_svc ) {
1177 if ( $pkg_svc{$pkg_svc->svcpart} ) {
1178 my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1179 $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1181 $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1187 my @pkg_svc = values(%pkg_svc);
1189 $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
1197 grep { $_->quantity }
1199 'select' => 'pkg_svc.*, part_svc.*',
1200 'table' => 'pkg_svc',
1201 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
1202 'hashref' => { 'pkgpart' => $self->pkgpart },
1206 =item svcpart [ SVCDB ]
1208 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1209 associated with this package definition (see L<FS::pkg_svc>). Returns
1210 false if there not a primary service definition or exactly one service
1211 definition with quantity 1, or if SVCDB is specified and does not match the
1212 svcdb of the service definition. SVCDB can be specified as a scalar table
1213 name, such as 'svc_acct', or as an arrayref of possible table names.
1218 my $pkg_svc = shift->_primary_pkg_svc(@_);
1219 $pkg_svc ? $pkg_svc->svcpart : '';
1222 =item part_svc [ SVCDB ]
1224 Like the B<svcpart> method, but returns the FS::part_svc object (see
1230 my $pkg_svc = shift->_primary_pkg_svc(@_);
1231 $pkg_svc ? $pkg_svc->part_svc : '';
1234 sub _primary_pkg_svc {
1237 my $svcdb = scalar(@_) ? shift : [];
1238 $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1239 my %svcdb = map { $_=>1 } @$svcdb;
1242 grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1245 my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1246 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1248 return '' if scalar(@pkg_svc) != 1;
1252 =item svcpart_unique_svcdb SVCDB
1254 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1255 SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
1256 false if there not a primary service definition for SVCDB or there are multiple
1257 service definitions for SVCDB.
1261 sub svcpart_unique_svcdb {
1262 my( $self, $svcdb ) = @_;
1263 my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1264 return '' if scalar(@svcdb_pkg_svc) != 1;
1265 $svcdb_pkg_svc[0]->svcpart;
1270 Returns a list of the acceptable payment types for this package. Eventually
1271 this should come out of a database table and be editable, but currently has the
1272 following logic instead:
1274 If the package is free, the single item B<BILL> is
1275 returned, otherwise, the single item B<CARD> is returned.
1277 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
1283 if ( $self->is_free ) {
1292 Returns true if this package is free.
1298 if ( $self->can('is_free_options') ) {
1299 not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1300 map { $self->option($_) }
1301 $self->is_free_options;
1303 warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1304 "provides neither is_free_options nor is_free method; returning false";
1309 # whether the plan allows discounts to be applied to this package
1310 sub can_discount { 0; }
1312 # whether the plan allows changing the start date
1313 sub can_start_date {
1315 $self->start_on_hold ? 0 : 1;
1318 # whether the plan supports part_pkg_usageprice add-ons (a specific kind of
1319 # pre-selectable usage pricing, there's others this doesn't refer to)
1320 sub can_usageprice { 0; }
1322 # the delay start date if present
1323 sub delay_start_date {
1326 my $delay = $self->delay_start or return '';
1328 # avoid timelocal silliness
1329 my $dt = DateTime->today(time_zone => 'local');
1330 $dt->add(days => $delay);
1334 sub can_currency_exchange { 0; }
1337 # moved to FS::Misc to make this accessible to other packages
1339 FS::Misc::pkg_freqs();
1344 Returns an english representation of the I<freq> field, such as "monthly",
1345 "weekly", "semi-annually", etc.
1351 my $freq = $self->freq;
1353 #my $freqs_href = $self->freqs_href;
1354 my $freqs_href = freqs_href();
1356 if ( exists($freqs_href->{$freq}) ) {
1357 $freqs_href->{$freq};
1359 my $interval = 'month';
1360 if ( $freq =~ /^(\d+)([hdw])$/ ) {
1361 my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1362 $interval = $interval{$2};
1367 "every $freq ${interval}s";
1372 =item add_freq TIMESTAMP [ FREQ ]
1374 Adds a billing period of some frequency to the provided timestamp and
1375 returns the resulting timestamp, or -1 if the frequency could not be
1376 parsed (shouldn't happen). By default, the frequency of this package
1377 will be used; to override this, pass a different frequency as a second
1383 my( $self, $date, $freq ) = @_;
1384 $freq = $self->freq unless $freq;
1386 #change this bit to use Date::Manip? CAREFUL with timezones (see
1387 # mailing list archive)
1388 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1390 if ( $freq =~ /^\d+$/ ) {
1392 until ( $mon < 12 ) { $mon -= 12; $year++; }
1394 $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1396 } elsif ( $freq =~ /^(\d+)w$/ ) {
1398 $mday += $weeks * 7;
1399 } elsif ( $freq =~ /^(\d+)d$/ ) {
1402 } elsif ( $freq =~ /^(\d+)h$/ ) {
1409 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1414 For backwards compatibility, returns the plandata field as well as all options
1415 from FS::part_pkg_option.
1421 carp "plandata is deprecated";
1423 $self->SUPER::plandata(@_);
1425 my $plandata = $self->get('plandata');
1426 my %options = $self->options;
1427 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1432 =item part_pkg_vendor
1434 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1435 L<FS::part_pkg_vendor>).
1437 =item vendor_pkg_ids
1439 Returns a list of vendor/external package ids by exportnum
1443 sub vendor_pkg_ids {
1445 map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1448 =item part_pkg_option
1450 Returns all options as FS::part_pkg_option objects (see
1451 L<FS::part_pkg_option>).
1455 Returns a list of option names and values suitable for assigning to a hash.
1461 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1464 =item option OPTIONNAME [ QUIET ]
1466 Returns the option value for the given name, or the empty string. If a true
1467 value is passed as the second argument, warnings about missing the option
1473 my( $self, $opt, $ornull ) = @_;
1475 #cache: was pulled up in the original part_pkg query
1476 return $self->hashref->{"_opt_$opt"}
1477 if exists $self->hashref->{"_opt_$opt"};
1479 cluck "$self -> option: searching for $opt" if $DEBUG;
1480 my $part_pkg_option =
1481 qsearchs('part_pkg_option', {
1482 pkgpart => $self->pkgpart,
1485 return $part_pkg_option->optionvalue if $part_pkg_option;
1487 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1488 split("\n", $self->get('plandata') );
1489 return $plandata{$opt} if exists $plandata{$opt};
1491 # check whether the option is defined in plan info (if so, don't warn)
1492 if (exists $plans{ $self->plan }->{fields}->{$opt}) {
1495 cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1496 "not found in options or plandata!\n"
1502 =item part_pkg_currency [ CURRENCY ]
1504 Returns all currency options as FS::part_pkg_currency objects (see
1505 L<FS::part_pkg_currency>), or, if a currency is specified, only return the
1506 objects for that currency.
1510 sub part_pkg_currency {
1512 my %hash = ( 'pkgpart' => $self->pkgpart );
1513 $hash{'currency'} = shift if @_;
1514 qsearch('part_pkg_currency', \%hash );
1517 =item part_pkg_currency_options CURRENCY
1519 Returns a list of option names and values from FS::part_pkg_currency for the
1524 sub part_pkg_currency_options {
1526 map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
1529 =item part_pkg_currency_option CURRENCY OPTIONNAME
1531 Returns the option value for the given name and currency.
1535 sub part_pkg_currency_option {
1536 my( $self, $currency, $optionname ) = @_;
1537 my $part_pkg_currency =
1538 qsearchs('part_pkg_currency', { 'pkgpart' => $self->pkgpart,
1539 'currency' => $currency,
1540 'optionname' => $optionname,
1543 #fatal if not found? that works for our use cases from
1544 #part_pkg/currency_fixed, but isn't how we would typically/expect the method
1545 #to behave. have to catch it there if we change it here...
1546 or die "Unknown price for ". $self->pkg_comment. " in $currency\n";
1548 $part_pkg_currency->optionvalue;
1551 =item fcc_option OPTIONNAME
1553 Returns the FCC 477 report option value for the given name, or the empty
1559 my ($self, $name) = @_;
1560 my $part_pkg_fcc_option =
1561 qsearchs('part_pkg_fcc_option', {
1562 pkgpart => $self->pkgpart,
1563 fccoptionname => $name,
1565 $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1570 Returns all FCC 477 report options for this package, as a hash-like list.
1576 map { $_->fccoptionname => $_->optionvalue }
1577 qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1580 =item bill_part_pkg_link
1582 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1586 sub bill_part_pkg_link {
1587 shift->_part_pkg_link('bill', @_);
1590 =item svc_part_pkg_link
1592 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1596 sub svc_part_pkg_link {
1597 shift->_part_pkg_link('svc', @_);
1600 =item supp_part_pkg_link
1602 Returns the associated part_pkg_link records of type 'supp' (supplemental
1607 sub supp_part_pkg_link {
1608 shift->_part_pkg_link('supp', @_);
1611 sub _part_pkg_link {
1612 my( $self, $type ) = @_;
1614 return @{ $cache_link{$type}->{$self->pkgpart} }
1615 if $cache_enabled && $cache_link{$type}->{$self->pkgpart};
1617 cluck $type.'_part_pkg_link called' if $DEBUG;
1620 qsearch({ table => 'part_pkg_link',
1621 hashref => { src_pkgpart => $self->pkgpart,
1623 #protection against infinite recursive links
1624 dst_pkgpart => { op=>'!=', value=> $self->pkgpart },
1626 order_by => "ORDER BY hidden",
1629 $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled;
1634 sub self_and_bill_linked {
1635 shift->_self_and_linked('bill', @_);
1638 sub self_and_svc_linked {
1639 shift->_self_and_linked('svc', @_);
1642 sub _self_and_linked {
1643 my( $self, $type, $hidden ) = @_;
1647 foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1648 $self->_part_pkg_link($type) ) )
1650 $_->hidden($hidden) if $hidden;
1657 =item part_pkg_taxoverride [ CLASS ]
1659 Returns all associated FS::part_pkg_taxoverride objects (see
1660 L<FS::part_pkg_taxoverride>). Limits the returned set to those
1661 of class CLASS if defined. Class may be one of 'setup', 'recur',
1662 the empty string (default), or a usage class number (see L<FS::usage_class>).
1663 When a class is specified, the empty string class (default) is returned
1664 if no more specific values exist.
1668 sub part_pkg_taxoverride {
1672 my $hashref = { 'pkgpart' => $self->pkgpart };
1673 $hashref->{'usage_class'} = $class if defined($class);
1674 my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1676 unless ( scalar(@overrides) || !defined($class) || !$class ){
1677 $hashref->{'usage_class'} = '';
1678 @overrides = qsearch('part_pkg_taxoverride', $hashref );
1684 =item has_taxproduct
1686 Returns true if this package has any taxproduct associated with it.
1690 sub has_taxproduct {
1693 $self->taxproductnum ||
1694 scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1695 keys %{ {$self->options} }
1701 =item taxproduct [ CLASS ]
1703 Returns the associated tax product for this package definition (see
1704 L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
1705 the usage classnum (see L<FS::usage_class>). Returns the default
1706 tax product for this record if the more specific CLASS value does
1715 my $part_pkg_taxproduct;
1717 my $taxproductnum = $self->taxproductnum;
1719 my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1720 $taxproductnum = $class_taxproductnum
1721 if $class_taxproductnum
1724 $part_pkg_taxproduct =
1725 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1727 unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1728 $taxproductnum = $self->taxproductnum;
1729 $part_pkg_taxproduct =
1730 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1733 $part_pkg_taxproduct;
1736 =item taxproduct_description [ CLASS ]
1738 Returns the description of the associated tax product for this package
1739 definition (see L<FS::part_pkg_taxproduct>).
1743 sub taxproduct_description {
1745 my $part_pkg_taxproduct = $self->taxproduct(@_);
1746 $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1749 =item units_taxproduct
1751 Returns the L<FS::part_pkg_taxproduct> record used to report the taxable
1752 service units (usually phone lines) on this package.
1756 sub units_taxproduct {
1758 $self->units_taxproductnum
1759 ? FS::part_pkg_taxproduct->by_key($self->units_taxproductnum)
1763 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1765 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1766 package in the location specified by GEOCODE, for usage class CLASS (one of
1767 'setup', 'recur', null, or a C<usage_class> number).
1773 my ($vendor, $geocode, $class) = @_;
1774 # if this part_pkg is overridden into a specific taxclass, get that class
1775 my @taxclassnums = map { $_->taxclassnum }
1776 $self->part_pkg_taxoverride($class);
1777 # otherwise, get its tax product category
1778 if (!@taxclassnums) {
1779 my $part_pkg_taxproduct = $self->taxproduct($class);
1780 # If this isn't defined, then the class has no taxproduct designation,
1781 # so return no tax rates.
1782 return () if !$part_pkg_taxproduct;
1784 # convert the taxproduct to the tax classes that might apply to it in
1786 @taxclassnums = map { $_->taxclassnum }
1787 grep { $_->taxable eq 'Y' } # why do we need this?
1788 $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1790 return unless @taxclassnums;
1792 # then look up the actual tax_rate entries
1793 warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1795 my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1796 my @taxes = qsearch({ 'table' => 'tax_rate',
1797 'hashref' => { 'geocode' => $geocode,
1798 'data_vendor' => $vendor,
1800 'extra_sql' => $extra_sql,
1802 warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1808 =item part_pkg_discount
1810 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1813 =item part_pkg_usage
1815 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1820 Returns the automatic transfer target for this package, or an empty string
1827 my $pkgpart = $self->change_to_pkgpart or return '';
1828 FS::part_pkg->by_key($pkgpart);
1833 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1834 PLAN is the object's I<plan> field. There should be better docs
1835 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1841 my $plan = $self->plan;
1843 cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1847 return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1848 my $class = ref($self). "::$plan";
1849 warn "reblessing $self into $class" if $DEBUG > 1;
1852 bless($self, $class) unless $@;
1856 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1858 =item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1860 Calculates and returns the setup or recurring fees, respectively, for this
1861 package. Implementation is in the FS::part_pkg:* module specific to this price
1864 Adds invoicing details to the passed-in DETAILS_ARRAYREF
1866 Options are passed as a hashref. Available options:
1872 Frequency override (for calc_recur)
1876 This option is filled in by the method rather than controlling its operation.
1877 It is an arrayref. Applicable discounts will be added to the arrayref, as
1878 L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
1882 For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
1883 no different than pkgpart.
1885 =item precommit_hooks
1887 This option is filled in by the method rather than controlling its operation.
1888 It is an arrayref. Anonymous coderefs will be added to the arrayref. They
1889 need to be called before completing the billing operation. For calc_recur
1892 =item increment_next_bill
1894 Increment the next bill date (boolean, for calc_recur). Typically true except
1895 for particular situations.
1899 This option is filled in by the method rather than controlling its operation.
1900 It indicates a deferred setup fee that is billed at calc_recur time (see price
1901 plan option prorate_defer_bill).
1905 Note: Don't calculate prices when not actually billing the package. For that,
1906 see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
1911 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1912 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1914 =item calc_remain CUST_PKG [ OPTION => VALUE ... ]
1916 Calculates and returns the remaining value to be credited upon package
1917 suspension, change, or cancellation, if enabled.
1919 Options are passed as a list of keys and values. Available options:
1925 Override for the current time
1927 =item cust_credit_source_bill_pkg
1929 This option is filled in by the method rather than controlling its operation.
1931 L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
1932 be added to the arrayref indicating the specific line items and amounts which
1933 are the source of this remaining credit.
1937 Note: Don't calculate prices when not actually suspending or cancelling the
1942 #fallback that returns 0 for old legacy packages with no plan
1943 sub calc_remain { 0; }
1945 =item calc_units CUST_PKG
1947 This returns the number of provisioned svc_phone records, or, of the package
1948 count_available_phones option is set, the number available to be provisioned
1954 my($self, $cust_pkg ) = @_;
1956 if ( $self->option('count_available_phones', 1)) {
1957 foreach my $pkg_svc ($cust_pkg->part_pkg->pkg_svc) {
1958 if ($pkg_svc->part_svc->svcdb eq 'svc_phone') { # svc_pbx?
1959 $count += $pkg_svc->quantity || 0;
1962 $count *= $cust_pkg->quantity;
1965 scalar(grep { $_->part_svc->svcdb eq 'svc_phone' } $cust_pkg->cust_svc);
1970 #fallback for everything not based on flat.pm
1971 sub recur_temporality { 'upcoming'; }
1973 =item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1975 Runs any necessary billing on cancellation: another recurring cycle for
1976 recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
1977 set (calc_recur), or, any outstanding usage for pacakges with the
1978 bill_usage_on_cancel option set (calc_usage).
1982 #fallback for everything not based on flat.pm, doesn't do this yet (which is
1983 #okay, nothing of ours not based on flat.pm does usage-on-cancel billing
1984 sub calc_cancel { 0; }
1986 #fallback for everything except bulk.pm
1987 sub hide_svc_detail { 0; }
1989 #fallback for packages that can't/won't summarize usage
1990 sub sum_usage { 0; }
1992 =item recur_cost_permonth CUST_PKG
1994 recur_cost divided by freq (only supported for monthly and longer frequencies)
1998 sub recur_cost_permonth {
1999 my($self, $cust_pkg) = @_;
2000 return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
2001 sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
2004 =item cust_bill_pkg_recur CUST_PKG
2006 Actual recurring charge for the specified customer package from customer's most
2011 sub cust_bill_pkg_recur {
2012 my($self, $cust_pkg) = @_;
2013 my $cust_bill_pkg = qsearchs({
2014 'table' => 'cust_bill_pkg',
2015 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
2016 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum,
2017 'recur' => { op=>'>', value=>'0' },
2019 'order_by' => 'ORDER BY cust_bill._date DESC,
2020 cust_bill_pkg.sdate DESC
2023 }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
2024 $cust_bill_pkg->recur;
2027 =item unit_setup CUST_PKG
2029 Returns the setup fee for one unit of the package.
2034 my ($self, $cust_pkg) = @_;
2035 $self->option('setup_fee') || 0;
2040 unit_setup minus setup_cost
2046 $self->unit_setup(@_) - ($self->setup_cost || 0);
2049 =item recur_margin_permonth
2051 base_recur_permonth minus recur_cost_permonth
2055 sub recur_margin_permonth {
2057 $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
2060 =item intro_end PACKAGE
2062 Takes an L<FS::cust_pkg> object. If this plan has an introductory rate,
2063 returns the expected date the intro period will end. If there is no intro
2072 =item format OPTION DATA
2074 Returns data formatted according to the function 'format' described
2075 in the plan info. Returns DATA if no such function exists.
2080 my ($self, $option, $data) = (shift, shift, shift);
2081 if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
2082 &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
2088 =item parse OPTION DATA
2090 Returns data parsed according to the function 'parse' described
2091 in the plan info. Returns DATA if no such function exists.
2096 my ($self, $option, $data) = (shift, shift, shift);
2097 if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
2098 &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
2108 =head1 CLASS METHODS
2116 # Used by FS::Upgrade to migrate to a new database.
2118 sub _upgrade_data { # class method
2119 my($class, %opts) = @_;
2121 warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
2123 my @part_pkg = qsearch({
2124 'table' => 'part_pkg',
2125 'extra_sql' => "WHERE ". join(' OR ',
2126 'plan IS NULL', "plan = '' ",
2130 foreach my $part_pkg (@part_pkg) {
2132 unless ( $part_pkg->plan ) {
2133 $part_pkg->plan('flat');
2140 # Convert RADIUS accounting usage metrics from megabytes to gigabytes
2142 my $upgrade = 'part_pkg_gigabyte_usage';
2143 if (!FS::upgrade_journal->is_done($upgrade)) {
2144 foreach my $part_pkg (qsearch('part_pkg',
2145 { plan => 'sqlradacct_hour' })
2148 my $pkgpart = $part_pkg->pkgpart;
2150 foreach my $opt (qsearch('part_pkg_option',
2151 { 'optionname' => { op => 'LIKE',
2152 value => 'recur_included_%',
2154 pkgpart => $pkgpart,
2157 next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
2158 next if $opt->optionvalue == 0;
2160 $opt->optionvalue($opt->optionvalue / 1024);
2162 my $error = $opt->replace;
2163 die $error if $error;
2166 foreach my $opt (qsearch('part_pkg_option',
2167 { 'optionname' => { op => 'LIKE',
2168 value => 'recur_%_charge',
2170 pkgpart => $pkgpart,
2172 $opt->optionvalue($opt->optionvalue * 1024);
2174 my $error = $opt->replace;
2175 die $error if $error;
2179 FS::upgrade_journal->set_done($upgrade);
2182 # the rest can be done asynchronously
2185 sub queueable_upgrade {
2186 # now upgrade to the explicit custom flag
2188 my $search = FS::Cursor->new({
2189 'table' => 'part_pkg',
2190 'hashref' => { disabled => 'Y', custom => '' },
2191 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
2195 while (my $part_pkg = $search->fetch) {
2196 my $new = new FS::part_pkg { $part_pkg->hash };
2198 my $comment = $part_pkg->comment;
2199 $comment =~ s/^\(CUSTOM\) //;
2200 $comment = '(none)' unless $comment =~ /\S/;
2201 $new->comment($comment);
2203 my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
2204 my $primary = $part_pkg->svcpart;
2205 my $options = { $part_pkg->options };
2207 my $error = $new->replace( $part_pkg,
2208 'pkg_svc' => $pkg_svc,
2209 'primary_svc' => $primary,
2210 'options' => $options,
2213 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2220 # set family_pkgpart on any packages that don't have it
2221 $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
2222 while (my $part_pkg = $search->fetch) {
2223 $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
2224 my $error = $part_pkg->SUPER::replace;
2226 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2233 my @part_pkg_option = qsearch('part_pkg_option',
2234 { 'optionname' => 'unused_credit',
2237 foreach my $old_opt (@part_pkg_option) {
2238 my $pkgpart = $old_opt->pkgpart;
2239 my $error = $old_opt->delete;
2240 die $error if $error;
2242 foreach (qw(unused_credit_cancel unused_credit_change)) {
2243 my $new_opt = new FS::part_pkg_option {
2244 'pkgpart' => $pkgpart,
2248 $error = $new_opt->insert;
2249 die $error if $error;
2253 # migrate use_disposition_taqua and use_disposition to disposition_in
2254 @part_pkg_option = qsearch('part_pkg_option',
2255 { 'optionname' => { op => 'LIKE',
2256 value => 'use_disposition%',
2260 my %newopts = map { $_->pkgpart => $_ }
2261 qsearch('part_pkg_option', { 'optionname' => 'disposition_in', } );
2262 foreach my $old_opt (@part_pkg_option) {
2263 my $pkgpart = $old_opt->pkgpart;
2264 my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
2266 my $error = $old_opt->delete;
2267 die $error if $error;
2269 if ( exists($newopts{$pkgpart}) ) {
2270 my $opt = $newopts{$pkgpart};
2271 $opt->optionvalue($opt->optionvalue.",$newval");
2272 $error = $opt->replace;
2273 die $error if $error;
2275 my $new_opt = new FS::part_pkg_option {
2276 'pkgpart' => $pkgpart,
2277 'optionname' => 'disposition_in',
2278 'optionvalue' => $newval,
2280 $error = $new_opt->insert;
2281 die $error if $error;
2282 $newopts{$pkgpart} = $new_opt;
2286 # set any package with FCC voice lines to the "VoIP with broadband" category
2287 # for backward compatibility
2289 # recover from a bad upgrade bug
2290 my $upgrade = 'part_pkg_fcc_voip_class_FIX';
2291 if (!FS::upgrade_journal->is_done($upgrade)) {
2292 my $bad_upgrade = qsearchs('upgrade_journal',
2293 { upgrade => 'part_pkg_fcc_voip_class' }
2295 if ( $bad_upgrade ) {
2296 my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
2297 ' AND history_date > '.($bad_upgrade->_date - 3600);
2298 my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
2301 'table' => 'h_part_pkg_option',
2303 'extra_sql' => "$where AND history_action = 'delete'",
2304 'order_by' => 'ORDER BY history_date ASC',
2306 my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
2309 'table' => 'h_pkg_svc',
2311 'extra_sql' => "$where AND history_action = 'replace_old'",
2312 'order_by' => 'ORDER BY history_date ASC',
2315 foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
2316 my $pkgpart ||= $deleted->pkgpart;
2317 $opt{$pkgpart} ||= {
2323 if ( $deleted->isa('FS::part_pkg_option') ) {
2324 $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
2326 my $svcpart = $deleted->svcpart;
2327 $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
2328 $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
2329 $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
2332 foreach my $pkgpart (keys %opt) {
2333 my $part_pkg = FS::part_pkg->by_key($pkgpart);
2334 my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
2336 die "error recovering damaged pkgpart $pkgpart:\n$error\n";
2339 } # $bad_upgrade exists
2340 else { # do the original upgrade, but correctly this time
2341 my @part_pkg = qsearch('part_pkg', {
2342 fcc_ds0s => { op => '>', value => 0 },
2343 fcc_voip_class => ''
2345 foreach my $part_pkg (@part_pkg) {
2346 $part_pkg->set(fcc_voip_class => 2);
2347 my @pkg_svc = $part_pkg->pkg_svc;
2348 my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
2349 my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc;
2350 my $error = $part_pkg->replace(
2351 $part_pkg->replace_old,
2352 options => { $part_pkg->options },
2353 pkg_svc => \%quantity,
2354 hidden_svc => \%hidden,
2355 primary_svc => ($part_pkg->svcpart || ''),
2357 die $error if $error;
2360 FS::upgrade_journal->set_done($upgrade);
2363 # migrate adjourn_months, expire_months, and contract_end_months to
2365 foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
2366 foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
2367 my $part_pkg = $option->part_pkg;
2368 my $error = $option->delete;
2369 if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
2370 $part_pkg->set($field, $option->optionvalue);
2371 $error ||= $part_pkg->replace;
2373 die $error if $error;
2377 # remove custom flag from one-time charge packages that were accidentally
2379 $search = FS::Cursor->new({
2380 'table' => 'part_pkg',
2381 'hashref' => { 'freq' => '0',
2383 'family_pkgpart' => { op => '!=', value => '' },
2385 'addl_from' => ' JOIN
2386 (select pkgpart from cust_pkg group by pkgpart having count(*) = 1)
2387 AS singular_pkg USING (pkgpart)',
2389 my @fields = grep { $_ ne 'pkgpart'
2391 and $_ ne 'disabled' } FS::part_pkg->fields;
2392 PKGPART: while (my $part_pkg = $search->fetch) {
2393 # can't merge the package back into its parent (too late for that)
2394 # but we can remove the custom flag if it's not actually customized,
2395 # i.e. nothing has been changed.
2397 my $family_pkgpart = $part_pkg->family_pkgpart;
2398 next PKGPART if $family_pkgpart == $part_pkg->pkgpart;
2399 my $parent_pkg = FS::part_pkg->by_key($family_pkgpart);
2400 foreach my $field (@fields) {
2401 if ($part_pkg->get($field) ne $parent_pkg->get($field)) {
2405 # options have to be identical too
2406 # but links, FCC options, discount plans, and usage packages can't be
2407 # changed through the "modify charge" UI, so skip them
2408 my %newopt = $part_pkg->options;
2409 my %oldopt = $parent_pkg->options;
2410 OPTION: foreach my $option (keys %newopt) {
2411 if (delete $newopt{$option} ne delete $oldopt{$option}) {
2415 if (keys(%newopt) or keys(%oldopt)) {
2418 # okay, now replace it
2419 warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n";
2420 $part_pkg->set('custom', '');
2421 my $error = $part_pkg->replace;
2422 die $error if $error;
2428 =item curuser_pkgs_sql
2430 Returns an SQL fragment for searching for packages the current user can
2431 use, either via part_pkg.agentnum directly, or via agent type (see
2436 sub curuser_pkgs_sql {
2439 $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2443 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2445 Returns an SQL fragment for searching for packages the provided agent or agents
2446 can use, either via part_pkg.agentnum directly, or via agent type (see
2451 sub agent_pkgs_sql {
2452 my $class = shift; #i'm a class method, not a sub (the question is... why??)
2453 my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2455 $class->_pkgs_sql(@agentnums); #is this why
2460 my( $class, @agentnums ) = @_;
2461 my $agentnums = join(',', @agentnums);
2465 ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2466 OR ( agentnum IS NULL
2467 AND EXISTS ( SELECT 1
2469 LEFT JOIN agent_type USING ( typenum )
2470 LEFT JOIN agent AS typeagent USING ( typenum )
2471 WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2472 AND typeagent.agentnum IN ($agentnums)
2480 =item join_options_sql
2482 Returns an SQL fragment for JOINing the part_pkg_option records for this
2483 package's setup_fee and recur_fee (as setup_option and recur_option,
2484 respectively). Useful for optimization.
2488 sub join_options_sql {
2491 LEFT JOIN part_pkg_option AS setup_option
2492 ON ( part_pkg.pkgpart = setup_option.pkgpart
2493 AND setup_option.optionname = 'setup_fee' )
2494 LEFT JOIN part_pkg_option AS recur_option
2495 ON ( part_pkg.pkgpart = recur_option.pkgpart
2496 AND recur_option.optionname = 'recur_fee' )
2510 #false laziness w/part_export & cdr
2512 foreach my $INC ( @INC ) {
2513 warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2514 foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2515 warn "attempting to load plan info from $file\n" if $DEBUG;
2516 $file =~ /\/(\w+)\.pm$/ or do {
2517 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2521 my $info = eval "use FS::part_pkg::$mod; ".
2522 "\\%FS::part_pkg::$mod\::info;";
2524 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2527 unless ( keys %$info ) {
2528 warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2531 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2532 #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2533 # warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2536 $info{$mod} = $info;
2537 $info->{'weight'} ||= 0; # quiet warnings
2541 # copy one level deep to allow replacement of fields and fieldorder
2542 tie %plans, 'Tie::IxHash',
2543 map { my %infohash = %{ $info{$_} };
2545 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2548 # inheritance of plan options
2549 foreach my $name (keys(%info)) {
2550 if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2551 warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2552 delete $plans{$name};
2555 my $parents = $info{$name}->{'inherit_fields'} || [];
2556 my (%fields, %field_exists, @fieldorder);
2557 foreach my $parent ($name, @$parents) {
2558 if ( !exists($info{$parent}) ) {
2559 warn "$name tried to inherit from nonexistent '$parent'\n";
2562 %fields = ( # avoid replacing existing fields
2563 %{ $info{$parent}->{'fields'} || {} },
2566 foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2568 next if $field_exists{$_};
2569 $field_exists{$_} = 1;
2570 # allow inheritors to remove inherited fields from the fieldorder
2571 push @fieldorder, $_ if !exists($fields{$_}) or
2572 !exists($fields{$_}->{'disabled'});
2575 $plans{$name}->{'fields'} = \%fields;
2576 $plans{$name}->{'fieldorder'} = \@fieldorder;
2586 =head1 NEW PLAN CLASSES
2588 A module should be added in FS/FS/part_pkg/ Eventually, an example may be
2589 found in eg/plan_template.pm. Until then, it is suggested that you use the
2590 other modules in FS/FS/part_pkg/ as a guide.
2594 The delete method is unimplemented.
2596 setup and recur semantics are not yet defined (and are implemented in
2597 FS::cust_bill. hmm.). now they're deprecated and need to go.
2601 part_pkg_taxrate is Pg specific
2603 replace should be smarter about managing the related tables (options, pkg_svc)
2607 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2608 schema.html from the base documentation.