2 use base qw( FS::m2m_Common FS::o2m_Common FS::option_Common );
5 use vars qw( %plans $DEBUG $setup_hack $skip_pkg_svc_hack
6 $cache_enabled %cache_link %cache_pkg_svc
8 use Carp qw(carp cluck confess);
9 use Scalar::Util qw( blessed );
11 use Time::Local qw( timelocal timelocal_nocheck ); # eventually replace with DateTime
14 use FS::Record qw( qsearch qsearchs dbh dbdef );
15 use FS::Cursor; # for upgrade
21 use FS::part_pkg_option;
22 use FS::part_pkg_fcc_option;
25 use FS::part_pkg_msgcat;
26 use FS::part_pkg_taxrate;
27 use FS::part_pkg_taxoverride;
28 use FS::part_pkg_taxproduct;
29 use FS::part_pkg_link;
30 use FS::part_pkg_discount;
31 use FS::part_pkg_usage;
32 use FS::part_pkg_vendor;
37 $skip_pkg_svc_hack = 0;
45 FS::part_pkg - Object methods for part_pkg objects
51 $record = new FS::part_pkg \%hash
52 $record = new FS::part_pkg { 'column' => 'value' };
54 $custom_record = $template_record->clone;
56 $error = $record->insert;
58 $error = $new_record->replace($old_record);
60 $error = $record->delete;
62 $error = $record->check;
64 @pkg_svc = $record->pkg_svc;
66 $svcnum = $record->svcpart;
67 $svcnum = $record->svcpart( 'svc_acct' );
71 An FS::part_pkg object represents a package definition. FS::part_pkg
72 inherits from FS::Record. The following fields are currently supported:
76 =item pkgpart - primary key (assigned automatically for new package definitions)
78 =item pkg - Text name of this package definition (customer-viewable)
80 =item comment - Text name of this package definition (non-customer-viewable)
82 =item classnum - Optional package class (see L<FS::pkg_class>)
84 =item promo_code - Promotional code
86 =item setup - Setup fee expression (deprecated)
88 =item freq - Frequency of recurring fee
90 =item recur - Recurring fee expression (deprecated)
92 =item setuptax - Setup fee tax exempt flag, empty or `Y'
94 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
96 =item taxclass - Tax class
98 =item plan - Price plan
100 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
102 =item disabled - Disabled flag, empty or `Y'
104 =item custom - Custom flag, empty or `Y'
106 =item setup_cost - for cost tracking
108 =item recur_cost - for cost tracking
110 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
112 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
114 =item agentnum - Optional agentnum (see L<FS::agent>)
116 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
118 =item fcc_voip_class - Which column of FCC form 477 part II.B this package
121 =item successor - Foreign key for the part_pkg that replaced this record.
122 If this record is not obsolete, will be null.
124 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
125 ancestor of this record. If this record is not a successor to another
126 part_pkg, will be equal to pkgpart.
128 =item delay_start - Number of days to delay package start, by default
130 =item start_on_hold - 'Y' to suspend this package immediately when it is
131 ordered. The package will not start billing or have a setup fee charged
132 until it is manually unsuspended.
142 Creates a new package definition. To add the package definition to
143 the database, see L<"insert">.
147 sub table { 'part_pkg'; }
151 An alternate constructor. Creates a new package definition by duplicating
152 an existing definition. A new pkgpart is assigned and the custom flag is
153 set to Y. To add the package definition to the database, see L<"insert">.
159 my $class = ref($self);
160 my %hash = $self->hash;
161 $hash{'pkgpart'} = '';
162 $hash{'custom'} = 'Y';
163 #new FS::part_pkg ( \%hash ); # ?
164 new $class ( \%hash ); # ?
167 =item insert [ , OPTION => VALUE ... ]
169 Adds this package definition to the database. If there is an error,
170 returns the error, otherwise returns false.
172 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
173 I<custnum_ref> and I<options>.
175 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
176 values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
177 be set to a hashref of svcparts and flag values ('Y' or '') to set the
178 'hidden' field in these records, and I<provision_hold> can be set similarly
179 for the 'provision_hold' field in these records.
181 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
182 FS::pkg_svc record will be updated.
184 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
185 record itself), the object will be updated to point to this package definition.
187 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
188 the scalar will be updated with the custnum value from the cust_pkg record.
190 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
191 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
192 records will be inserted.
194 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
195 records will be inserted.
202 warn "FS::part_pkg::insert called on $self with options ".
203 join(', ', map "$_=>$options{$_}", keys %options)
206 local $SIG{HUP} = 'IGNORE';
207 local $SIG{INT} = 'IGNORE';
208 local $SIG{QUIT} = 'IGNORE';
209 local $SIG{TERM} = 'IGNORE';
210 local $SIG{TSTP} = 'IGNORE';
211 local $SIG{PIPE} = 'IGNORE';
213 my $oldAutoCommit = $FS::UID::AutoCommit;
214 local $FS::UID::AutoCommit = 0;
217 warn " inserting part_pkg record" if $DEBUG;
218 my $error = $self->SUPER::insert( $options{options} );
220 $dbh->rollback if $oldAutoCommit;
225 if ( $self->get('family_pkgpart') eq '' ) {
226 $self->set('family_pkgpart' => $self->pkgpart);
227 $error = $self->SUPER::replace;
229 $dbh->rollback if $oldAutoCommit;
234 warn " inserting part_pkg_taxoverride records" if $DEBUG;
235 my %overrides = %{ $options{'tax_overrides'} || {} };
236 foreach my $usage_class ( keys %overrides ) {
238 ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
239 ? $overrides{$usage_class}
241 my @overrides = (grep "$_", split(',', $override) );
242 my $error = $self->process_m2m (
243 'link_table' => 'part_pkg_taxoverride',
244 'target_table' => 'tax_class',
245 'hashref' => { 'usage_class' => $usage_class },
246 'params' => \@overrides,
249 $dbh->rollback if $oldAutoCommit;
254 unless ( $skip_pkg_svc_hack ) {
256 warn " inserting pkg_svc records" if $DEBUG;
257 my $pkg_svc = $options{'pkg_svc'} || {};
258 my $hidden_svc = $options{'hidden_svc'} || {};
259 my $provision_hold = $options{'provision_hold'} || {};
260 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
261 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
263 ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
267 my $pkg_svc = new FS::pkg_svc( {
268 'pkgpart' => $self->pkgpart,
269 'svcpart' => $part_svc->svcpart,
270 'quantity' => $quantity,
271 'primary_svc' => $primary_svc,
272 'hidden' => $hidden_svc->{$part_svc->svcpart},
273 'provision_hold' => $provision_hold->{$part_svc->svcpart},
275 my $error = $pkg_svc->insert;
277 $dbh->rollback if $oldAutoCommit;
284 if ( $options{'cust_pkg'} ) {
285 warn " updating cust_pkg record " if $DEBUG;
287 ref($options{'cust_pkg'})
288 ? $options{'cust_pkg'}
289 : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
290 ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
291 if $options{'custnum_ref'};
292 my %hash = $old_cust_pkg->hash;
293 $hash{'pkgpart'} = $self->pkgpart,
294 my $new_cust_pkg = new FS::cust_pkg \%hash;
295 local($FS::cust_pkg::disable_agentcheck) = 1;
296 my $error = $new_cust_pkg->replace($old_cust_pkg);
298 $dbh->rollback if $oldAutoCommit;
299 return "Error modifying cust_pkg record: $error";
303 if ( $options{'part_pkg_vendor'} ) {
304 while ( my ($exportnum, $vendor_pkg_id) =
305 each %{ $options{part_pkg_vendor} }
308 my $ppv = new FS::part_pkg_vendor( {
309 'pkgpart' => $self->pkgpart,
310 'exportnum' => $exportnum,
311 'vendor_pkg_id' => $vendor_pkg_id,
313 my $error = $ppv->insert;
315 $dbh->rollback if $oldAutoCommit;
316 return "Error inserting part_pkg_vendor record: $error";
321 if ( $options{fcc_options} ) {
322 warn " updating fcc options " if $DEBUG;
323 $self->set_fcc_options( $options{fcc_options} );
326 warn " committing transaction" if $DEBUG and $oldAutoCommit;
327 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
334 Currently unimplemented.
339 return "Can't (yet?) delete package definitions.";
340 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
343 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
345 Replaces OLD_RECORD with this one in the database. If there is an error,
346 returns the error, otherwise returns false.
348 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>,
349 I<provision_hold> and I<options>
351 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
352 values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
353 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
354 'hidden' field in these records. I<provision_hold> can be set
355 to a hashref of svcparts and flag values ('Y' or '') to set the field
358 If I<primary_svc> is set to the svcpart of the primary service, the
359 appropriate FS::pkg_svc record will be updated.
361 If I<options> is set to a hashref, the appropriate FS::part_pkg_option
362 records will be replaced.
369 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
374 ( ref($_[0]) eq 'HASH' )
378 $options->{options} = { $old->options } unless defined($options->{options});
380 warn "FS::part_pkg::replace called on $new to replace $old with options".
381 join(', ', map "$_ => ". $options->{$_}, keys %$options)
384 local $SIG{HUP} = 'IGNORE';
385 local $SIG{INT} = 'IGNORE';
386 local $SIG{QUIT} = 'IGNORE';
387 local $SIG{TERM} = 'IGNORE';
388 local $SIG{TSTP} = 'IGNORE';
389 local $SIG{PIPE} = 'IGNORE';
391 my $oldAutoCommit = $FS::UID::AutoCommit;
392 local $FS::UID::AutoCommit = 0;
395 my $conf = new FS::Conf;
396 if ( $conf->exists('part_pkg-lineage') ) {
397 if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
398 qw(setup_fee recur_fee) #others? config?
401 warn " superseding package" if $DEBUG;
403 my $error = $new->supersede($old, %$options);
405 $dbh->rollback if $oldAutoCommit;
409 warn " committing transaction" if $DEBUG and $oldAutoCommit;
410 $dbh->commit if $oldAutoCommit;
417 #plandata shit stays in replace for upgrades until after 2.0 (or edit
419 warn " saving legacy plandata" if $DEBUG;
420 my $plandata = $new->get('plandata');
421 $new->set('plandata', '');
423 warn " deleting old part_pkg_option records" if $DEBUG;
424 foreach my $part_pkg_option ( $old->part_pkg_option ) {
425 my $error = $part_pkg_option->delete;
427 $dbh->rollback if $oldAutoCommit;
432 warn " replacing part_pkg record" if $DEBUG;
433 my $error = $new->SUPER::replace($old, $options->{options} );
435 $dbh->rollback if $oldAutoCommit;
439 warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
440 foreach my $part_pkg_option (
441 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
442 return "illegal plandata: $plandata";
444 new FS::part_pkg_option {
445 'pkgpart' => $new->pkgpart,
450 split("\n", $plandata)
452 my $error = $part_pkg_option->insert;
454 $dbh->rollback if $oldAutoCommit;
459 warn " replacing pkg_svc records" if $DEBUG;
460 my $pkg_svc = $options->{'pkg_svc'};
461 my $hidden_svc = $options->{'hidden_svc'} || {};
462 my $provision_hold = $options->{'provision_hold'} || {};
463 if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
464 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
465 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
466 my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
467 my $provision_hold = $provision_hold->{$part_svc->svcpart} || '';
469 ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
470 && $options->{'primary_svc'} == $part_svc->svcpart
475 my $old_pkg_svc = qsearchs('pkg_svc', {
476 'pkgpart' => $old->pkgpart,
477 'svcpart' => $part_svc->svcpart,
480 my $old_quantity = 0;
481 my $old_primary_svc = '';
483 my $old_provision_hold = '';
484 if ( $old_pkg_svc ) {
485 $old_quantity = $old_pkg_svc->quantity;
486 $old_primary_svc = $old_pkg_svc->primary_svc
487 if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
488 $old_hidden = $old_pkg_svc->hidden;
489 $old_provision_hold = $old_pkg_svc->provision_hold;
492 next unless $old_quantity != $quantity ||
493 $old_primary_svc ne $primary_svc ||
494 $old_hidden ne $hidden ||
495 $old_provision_hold ne $provision_hold;
497 my $new_pkg_svc = new FS::pkg_svc( {
498 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
499 'pkgpart' => $new->pkgpart,
500 'svcpart' => $part_svc->svcpart,
501 'quantity' => $quantity,
502 'primary_svc' => $primary_svc,
504 'provision_hold' => $provision_hold,
506 my $error = $old_pkg_svc
507 ? $new_pkg_svc->replace($old_pkg_svc)
508 : $new_pkg_svc->insert;
510 $dbh->rollback if $oldAutoCommit;
514 } #if $options->{pkg_svc}
516 my @part_pkg_vendor = $old->part_pkg_vendor;
517 my @current_exportnum = ();
518 if ( $options->{'part_pkg_vendor'} ) {
519 my($exportnum,$vendor_pkg_id);
520 while ( ($exportnum,$vendor_pkg_id)
521 = each %{$options->{'part_pkg_vendor'}} ) {
523 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
524 if($exportnum == $part_pkg_vendor->exportnum
525 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
526 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
527 my $error = $part_pkg_vendor->replace;
529 $dbh->rollback if $oldAutoCommit;
530 return "Error replacing part_pkg_vendor record: $error";
535 elsif($exportnum == $part_pkg_vendor->exportnum
536 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
541 unless ( $noinsert ) {
542 my $ppv = new FS::part_pkg_vendor( {
543 'pkgpart' => $new->pkgpart,
544 'exportnum' => $exportnum,
545 'vendor_pkg_id' => $vendor_pkg_id,
547 my $error = $ppv->insert;
549 $dbh->rollback if $oldAutoCommit;
550 return "Error inserting part_pkg_vendor record: $error";
553 push @current_exportnum, $exportnum;
556 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
557 unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
558 my $error = $part_pkg_vendor->delete;
560 $dbh->rollback if $oldAutoCommit;
561 return "Error deleting part_pkg_vendor record: $error";
566 # propagate changes to certain core fields
567 if ( $conf->exists('part_pkg-lineage') ) {
568 warn " propagating changes to family" if $DEBUG;
569 my $error = $new->propagate($old);
571 $dbh->rollback if $oldAutoCommit;
576 if ( $options->{fcc_options} ) {
577 warn " updating fcc options " if $DEBUG;
578 $new->set_fcc_options( $options->{fcc_options} );
581 warn " committing transaction" if $DEBUG and $oldAutoCommit;
582 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
586 sub validate_number {
587 my ($option, $valref) = @_;
589 $$valref = 0 unless $$valref;
590 return "Invalid $option"
591 unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
595 sub validate_number_blank {
596 my ($option, $valref) = @_;
599 return "Invalid $option"
600 unless ($$valref) = ($$valref =~ /^\s*(\d+)\s*$/);
607 Checks all fields to make sure this is a valid package definition. If
608 there is an error, returns the error, otherwise returns false. Called by the
609 insert and replace methods.
615 warn "FS::part_pkg::check called on $self" if $DEBUG;
617 for (qw(setup recur plandata)) {
618 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
619 return "Use of $_ field is deprecated; set a plan and options: ".
621 if length($self->get($_));
625 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
626 my $error = $self->ut_number('freq');
627 return $error if $error;
629 $self->freq =~ /^(\d+[hdw]?)$/
630 or return "Illegal or empty freq: ". $self->freq;
634 my @null_agentnum_right = ( 'Edit global package definitions' );
635 push @null_agentnum_right, 'One-time charge'
636 if $self->freq =~ /^0/;
637 push @null_agentnum_right, 'Customize customer package'
638 if $self->disabled eq 'Y'; #good enough
640 my $error = $self->ut_numbern('pkgpart')
641 || $self->ut_text('pkg')
642 || $self->ut_textn('comment')
643 || $self->ut_textn('promo_code')
644 || $self->ut_alphan('plan')
645 || $self->ut_flag('setuptax')
646 || $self->ut_flag('recurtax')
647 || $self->ut_textn('taxclass')
648 || $self->ut_flag('disabled')
649 || $self->ut_flag('custom')
650 || $self->ut_flag('no_auto')
651 || $self->ut_flag('recur_show_zero')
652 || $self->ut_flag('setup_show_zero')
653 || $self->ut_flag('start_on_hold')
654 #|| $self->ut_moneyn('setup_cost')
655 #|| $self->ut_moneyn('recur_cost')
656 || $self->ut_floatn('setup_cost')
657 || $self->ut_floatn('recur_cost')
658 || $self->ut_floatn('pay_weight')
659 || $self->ut_floatn('credit_weight')
660 || $self->ut_numbern('taxproductnum')
661 || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
662 || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
663 || $self->ut_foreign_keyn('taxproductnum',
664 'part_pkg_taxproduct',
668 ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
669 : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
671 || $self->ut_numbern('fcc_ds0s')
672 || $self->ut_numbern('fcc_voip_class')
673 || $self->ut_numbern('delay_start')
674 || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
675 || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
676 || $self->ut_alphan('agent_pkgpartid')
677 || $self->SUPER::check
679 return $error if $error;
681 return 'Unknown plan '. $self->plan
682 unless exists($plans{$self->plan});
684 my $conf = new FS::Conf;
685 return 'Taxclass is required'
686 if ! $self->taxclass && $conf->exists('require_taxclasses');
693 Pass an I<$options> hashref that contains the values to be
694 inserted or updated for any FS::part_pkg::MODULE.pm.
696 For each key in I<$options>, validates the value by calling
697 the 'validate' subroutine defined for that option e.g.
698 FS::part_pkg::MODULE::plan_info()->{$KEY}->{validate}. The
699 option validation function is only called when the hashkey for
700 that option exists in I<$options>.
702 Then the module validation function is called, from
703 FS::part_pkg::MODULE::plan_info()->{validate}
705 Returns error message, or empty string if valid.
707 Invoked by L</insert> and L</replace> via the equivalent
708 methods in L<FS::option_Common>.
713 my ($self,$options) = @_;
714 foreach my $option (keys %$options) {
715 if (exists $plans{ $self->plan }->{fields}->{$option}) {
716 if (exists($plans{$self->plan}->{fields}->{$option}->{'validate'})) {
717 # pass option name for use in error message
718 # pass a reference to the $options value, so it can be cleaned up
719 my $error = &{$plans{$self->plan}->{fields}->{$option}->{'validate'}}($option,\($options->{$option}));
720 return $error if $error;
722 } # else "option does not exist" error?
724 if (exists($plans{$self->plan}->{'validate'})) {
725 my $error = &{$plans{$self->plan}->{'validate'}}($options);
726 return $error if $error;
731 =item supersede OLD [, OPTION => VALUE ... ]
733 Inserts this package as a successor to the package OLD. All options are as
734 for C<insert>. After inserting, disables OLD and sets the new package as its
740 my ($new, $old, %options) = @_;
743 $new->set('pkgpart' => '');
744 $new->set('family_pkgpart' => $old->family_pkgpart);
745 warn " inserting successor package\n" if $DEBUG;
746 $error = $new->insert(%options);
747 return $error if $error;
749 warn " disabling superseded package\n" if $DEBUG;
750 $old->set('successor' => $new->pkgpart);
751 $old->set('disabled' => 'Y');
752 $error = $old->SUPER::replace; # don't change its options/pkg_svc records
753 return $error if $error;
755 warn " propagating changes to family" if $DEBUG;
756 $new->propagate($old);
761 If any of certain fields have changed from OLD to this package, then,
762 for all packages in the same lineage as this one, sets those fields
763 to their values in this package.
767 my @propagate_fields = (
768 qw( pkg classnum setup_cost recur_cost taxclass
769 setuptax recurtax pay_weight credit_weight
777 map { $_ => $new->get($_) }
778 grep { $new->get($_) ne $old->get($_) }
782 my @part_pkg = qsearch('part_pkg', {
783 'family_pkgpart' => $new->family_pkgpart
786 foreach my $part_pkg ( @part_pkg ) {
787 my $pkgpart = $part_pkg->pkgpart;
788 next if $pkgpart == $new->pkgpart; # don't modify $new
789 warn " propagating to pkgpart $pkgpart\n" if $DEBUG;
790 foreach ( keys %fields ) {
791 $part_pkg->set($_, $fields{$_});
793 # SUPER::replace to avoid changing non-core fields
794 my $error = $part_pkg->SUPER::replace;
795 push @error, "pkgpart $pkgpart: $error"
801 =item set_fcc_options HASHREF
803 Sets the FCC options on this package definition to the values specified
808 sub set_fcc_options {
810 my $pkgpart = $self->pkgpart;
818 my %existing_num = map { $_->fccoptionname => $_->num }
819 qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
821 local $FS::Record::nowarn_identical = 1;
822 # set up params for process_o2m
825 foreach my $name (keys %$options ) {
826 $params->{ "num$i" } = $existing_num{$name} || '';
827 $params->{ "num$i".'_fccoptionname' } = $name;
828 $params->{ "num$i".'_optionvalue' } = $options->{$name};
833 table => 'part_pkg_fcc_option',
834 fields => [qw( fccoptionname optionvalue )],
839 =item pkg_locale LOCALE
841 Returns a customer-viewable string representing this package for the given
842 locale, from the part_pkg_msgcat table. If the given locale is empty or no
843 localized string is found, returns the base pkg field.
848 my( $self, $locale ) = @_;
849 return $self->pkg unless $locale;
850 my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
851 $part_pkg_msgcat->pkg;
854 =item part_pkg_msgcat LOCALE
856 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
860 sub part_pkg_msgcat {
861 my( $self, $locale ) = @_;
862 qsearchs( 'part_pkg_msgcat', {
863 pkgpart => $self->pkgpart,
868 =item pkg_comment [ OPTION => VALUE... ]
870 Returns an (internal) string representing this package. Currently,
871 "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
872 future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
875 If the option nopkgpart is true then the "pkgpart: ' is omitted.
883 #$self->pkg. ' - '. $self->comment;
884 #$self->pkg. ' ('. $self->comment. ')';
885 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
886 my $custom_comment = $self->custom_comment(%opt);
887 $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
890 #without price info (so without hitting the DB again)
891 sub pkg_comment_only {
895 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
896 my $comment = $self->comment;
897 $pre. $self->pkg. ( $comment ? " - $comment" : '' );
900 sub price_info { # safety, in case a part_pkg hasn't defined price_info
906 my $price_info = $self->price_info(@_);
907 ( $self->custom ? '(CUSTOM) ' : '' ).
909 ( ( ($self->custom || $self->comment) && $price_info ) ? ' - ' : '' ).
915 $self->pkg. ' - '. ($self->price_info || 'No charge');
920 Returns the package class, as an FS::pkg_class object, or the empty string
921 if there is no package class.
927 if ( $self->classnum ) {
928 qsearchs('pkg_class', { 'classnum' => $self->classnum } );
934 =item addon_pkg_class
936 Returns the add-on package class, as an FS::pkg_class object, or the empty
937 string if there is no add-on package class.
941 sub addon_pkg_class {
943 if ( $self->addon_classnum ) {
944 qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
952 Returns the package category name, or the empty string if there is no package
959 my $pkg_class = $self->pkg_class;
961 ? $pkg_class->categoryname
967 Returns the package class name, or the empty string if there is no package
974 my $pkg_class = $self->pkg_class;
976 ? $pkg_class->classname
980 =item addon_classname
982 Returns the add-on package class name, or the empty string if there is no
983 add-on package class.
987 sub addon_classname {
989 my $pkg_class = $self->addon_pkg_class;
991 ? $pkg_class->classname
997 Returns the associated agent for this event, if any, as an FS::agent object.
1003 qsearchs('agent', { 'agentnum' => $self->agentnum } );
1006 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1008 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1009 definition (with non-zero quantity).
1011 One option is available, I<disable_linked>. If set true it will return the
1012 services for this package definition alone, omitting services from any add-on
1019 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1026 qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
1032 return @{ $cache_pkg_svc{$self->pkgpart} }
1033 if $cache_enabled && $cache_pkg_svc{$self->pkgpart};
1035 # #sort { $b->primary cmp $a->primary }
1036 # grep { $_->quantity }
1037 # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1039 my $opt = ref($_[0]) ? $_[0] : { @_ };
1040 my %pkg_svc = map { $_->svcpart => $_ } $self->_pkg_svc;
1042 unless ( $opt->{disable_linked} ) {
1043 foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1044 my @pkg_svc = $dst_pkg->_pkg_svc;
1045 foreach my $pkg_svc ( @pkg_svc ) {
1046 if ( $pkg_svc{$pkg_svc->svcpart} ) {
1047 my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1048 $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1050 $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1056 my @pkg_svc = values(%pkg_svc);
1058 $cache_pkg_svc{$self->pkgpart} = \@pkg_svc if $cache_enabled;
1066 grep { $_->quantity }
1068 'select' => 'pkg_svc.*, part_svc.*',
1069 'table' => 'pkg_svc',
1070 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
1071 'hashref' => { 'pkgpart' => $self->pkgpart },
1075 =item svcpart [ SVCDB ]
1077 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1078 associated with this package definition (see L<FS::pkg_svc>). Returns
1079 false if there not a primary service definition or exactly one service
1080 definition with quantity 1, or if SVCDB is specified and does not match the
1081 svcdb of the service definition. SVCDB can be specified as a scalar table
1082 name, such as 'svc_acct', or as an arrayref of possible table names.
1087 my $pkg_svc = shift->_primary_pkg_svc(@_);
1088 $pkg_svc ? $pkg_svc->svcpart : '';
1091 =item part_svc [ SVCDB ]
1093 Like the B<svcpart> method, but returns the FS::part_svc object (see
1099 my $pkg_svc = shift->_primary_pkg_svc(@_);
1100 $pkg_svc ? $pkg_svc->part_svc : '';
1103 sub _primary_pkg_svc {
1106 my $svcdb = scalar(@_) ? shift : [];
1107 $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1108 my %svcdb = map { $_=>1 } @$svcdb;
1111 grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1114 my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1115 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1117 return '' if scalar(@pkg_svc) != 1;
1121 =item svcpart_unique_svcdb SVCDB
1123 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1124 SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
1125 false if there not a primary service definition for SVCDB or there are multiple
1126 service definitions for SVCDB.
1130 sub svcpart_unique_svcdb {
1131 my( $self, $svcdb ) = @_;
1132 my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1133 return '' if scalar(@svcdb_pkg_svc) != 1;
1134 $svcdb_pkg_svc[0]->svcpart;
1139 Returns a list of the acceptable payment types for this package. Eventually
1140 this should come out of a database table and be editable, but currently has the
1141 following logic instead:
1143 If the package is free, the single item B<BILL> is
1144 returned, otherwise, the single item B<CARD> is returned.
1146 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
1152 if ( $self->is_free ) {
1161 Returns true if this package is free.
1167 if ( $self->can('is_free_options') ) {
1168 not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1169 map { $self->option($_) }
1170 $self->is_free_options;
1172 warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1173 "provides neither is_free_options nor is_free method; returning false";
1178 # whether the plan allows discounts to be applied to this package
1179 sub can_discount { 0; }
1181 # whether the plan allows changing the start date
1182 sub can_start_date {
1184 $self->start_on_hold ? 0 : 1;
1187 # the delay start date if present
1188 sub delay_start_date {
1191 my $delay = $self->delay_start or return '';
1193 # avoid timelocal silliness
1194 my $dt = DateTime->today(time_zone => 'local');
1195 $dt->add(days => $delay);
1200 # moved to FS::Misc to make this accessible to other packages
1202 FS::Misc::pkg_freqs();
1207 Returns an english representation of the I<freq> field, such as "monthly",
1208 "weekly", "semi-annually", etc.
1214 my $freq = $self->freq;
1216 #my $freqs_href = $self->freqs_href;
1217 my $freqs_href = freqs_href();
1219 if ( exists($freqs_href->{$freq}) ) {
1220 $freqs_href->{$freq};
1222 my $interval = 'month';
1223 if ( $freq =~ /^(\d+)([hdw])$/ ) {
1224 my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1225 $interval = $interval{$2};
1230 "every $freq ${interval}s";
1235 =item add_freq TIMESTAMP [ FREQ ]
1237 Adds a billing period of some frequency to the provided timestamp and
1238 returns the resulting timestamp, or -1 if the frequency could not be
1239 parsed (shouldn't happen). By default, the frequency of this package
1240 will be used; to override this, pass a different frequency as a second
1246 my( $self, $date, $freq ) = @_;
1247 $freq = $self->freq unless $freq;
1249 #change this bit to use Date::Manip? CAREFUL with timezones (see
1250 # mailing list archive)
1251 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1253 if ( $freq =~ /^\d+$/ ) {
1255 until ( $mon < 12 ) { $mon -= 12; $year++; }
1257 $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1259 } elsif ( $freq =~ /^(\d+)w$/ ) {
1261 $mday += $weeks * 7;
1262 } elsif ( $freq =~ /^(\d+)d$/ ) {
1265 } elsif ( $freq =~ /^(\d+)h$/ ) {
1272 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1277 For backwards compatibility, returns the plandata field as well as all options
1278 from FS::part_pkg_option.
1284 carp "plandata is deprecated";
1286 $self->SUPER::plandata(@_);
1288 my $plandata = $self->get('plandata');
1289 my %options = $self->options;
1290 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1295 =item part_pkg_vendor
1297 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1298 L<FS::part_pkg_vendor>).
1302 sub part_pkg_vendor {
1304 qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
1307 =item vendor_pkg_ids
1309 Returns a list of vendor/external package ids by exportnum
1313 sub vendor_pkg_ids {
1315 map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1318 =item part_pkg_option
1320 Returns all options as FS::part_pkg_option objects (see
1321 L<FS::part_pkg_option>).
1325 sub part_pkg_option {
1327 qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
1332 Returns a list of option names and values suitable for assigning to a hash.
1338 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1341 =item option OPTIONNAME [ QUIET ]
1343 Returns the option value for the given name, or the empty string. If a true
1344 value is passed as the second argument, warnings about missing the option
1350 my( $self, $opt, $ornull ) = @_;
1352 #cache: was pulled up in the original part_pkg query
1353 return $self->hashref->{"_opt_$opt"}
1354 if exists $self->hashref->{"_opt_$opt"};
1356 cluck "$self -> option: searching for $opt" if $DEBUG;
1357 my $part_pkg_option =
1358 qsearchs('part_pkg_option', {
1359 pkgpart => $self->pkgpart,
1362 return $part_pkg_option->optionvalue if $part_pkg_option;
1364 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1365 split("\n", $self->get('plandata') );
1366 return $plandata{$opt} if exists $plandata{$opt};
1367 cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1368 "not found in options or plandata!\n"
1374 =item fcc_option OPTIONNAME
1376 Returns the FCC 477 report option value for the given name, or the empty
1382 my ($self, $name) = @_;
1383 my $part_pkg_fcc_option =
1384 qsearchs('part_pkg_fcc_option', {
1385 pkgpart => $self->pkgpart,
1386 fccoptionname => $name,
1388 $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1393 Returns all FCC 477 report options for this package, as a hash-like list.
1399 map { $_->fccoptionname => $_->optionvalue }
1400 qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1403 =item bill_part_pkg_link
1405 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1409 sub bill_part_pkg_link {
1410 shift->_part_pkg_link('bill', @_);
1413 =item svc_part_pkg_link
1415 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1419 sub svc_part_pkg_link {
1420 shift->_part_pkg_link('svc', @_);
1423 =item supp_part_pkg_link
1425 Returns the associated part_pkg_link records of type 'supp' (supplemental
1430 sub supp_part_pkg_link {
1431 shift->_part_pkg_link('supp', @_);
1434 sub _part_pkg_link {
1435 my( $self, $type ) = @_;
1437 return @{ $cache_link{$type}->{$self->pkgpart} }
1438 if $cache_enabled && $cache_link{$type}->{$self->pkgpart};
1440 cluck $type.'_part_pkg_link called' if $DEBUG;
1443 qsearch({ table => 'part_pkg_link',
1444 hashref => { src_pkgpart => $self->pkgpart,
1446 #protection against infinite recursive links
1447 dst_pkgpart => { op=>'!=', value=> $self->pkgpart },
1449 order_by => "ORDER BY hidden",
1452 $cache_link{$type}->{$self->pkgpart} = \@ppl if $cache_enabled;
1457 sub self_and_bill_linked {
1458 shift->_self_and_linked('bill', @_);
1461 sub self_and_svc_linked {
1462 shift->_self_and_linked('svc', @_);
1465 sub _self_and_linked {
1466 my( $self, $type, $hidden ) = @_;
1470 foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1471 $self->_part_pkg_link($type) ) )
1473 $_->hidden($hidden) if $hidden;
1480 =item part_pkg_taxoverride [ CLASS ]
1482 Returns all associated FS::part_pkg_taxoverride objects (see
1483 L<FS::part_pkg_taxoverride>). Limits the returned set to those
1484 of class CLASS if defined. Class may be one of 'setup', 'recur',
1485 the empty string (default), or a usage class number (see L<FS::usage_class>).
1486 When a class is specified, the empty string class (default) is returned
1487 if no more specific values exist.
1491 sub part_pkg_taxoverride {
1495 my $hashref = { 'pkgpart' => $self->pkgpart };
1496 $hashref->{'usage_class'} = $class if defined($class);
1497 my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1499 unless ( scalar(@overrides) || !defined($class) || !$class ){
1500 $hashref->{'usage_class'} = '';
1501 @overrides = qsearch('part_pkg_taxoverride', $hashref );
1507 =item has_taxproduct
1509 Returns true if this package has any taxproduct associated with it.
1513 sub has_taxproduct {
1516 $self->taxproductnum ||
1517 scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1518 keys %{ {$self->options} }
1524 =item taxproduct [ CLASS ]
1526 Returns the associated tax product for this package definition (see
1527 L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
1528 the usage classnum (see L<FS::usage_class>). Returns the default
1529 tax product for this record if the more specific CLASS value does
1538 my $part_pkg_taxproduct;
1540 my $taxproductnum = $self->taxproductnum;
1542 my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1543 $taxproductnum = $class_taxproductnum
1544 if $class_taxproductnum
1547 $part_pkg_taxproduct =
1548 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1550 unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1551 $taxproductnum = $self->taxproductnum;
1552 $part_pkg_taxproduct =
1553 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1556 $part_pkg_taxproduct;
1559 =item taxproduct_description [ CLASS ]
1561 Returns the description of the associated tax product for this package
1562 definition (see L<FS::part_pkg_taxproduct>).
1566 sub taxproduct_description {
1568 my $part_pkg_taxproduct = $self->taxproduct(@_);
1569 $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1573 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1575 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1576 package in the location specified by GEOCODE, for usage class CLASS (one of
1577 'setup', 'recur', null, or a C<usage_class> number).
1583 my ($vendor, $geocode, $class) = @_;
1584 # if this part_pkg is overridden into a specific taxclass, get that class
1585 my @taxclassnums = map { $_->taxclassnum }
1586 $self->part_pkg_taxoverride($class);
1587 # otherwise, get its tax product category
1588 if (!@taxclassnums) {
1589 my $part_pkg_taxproduct = $self->taxproduct($class);
1590 # If this isn't defined, then the class has no taxproduct designation,
1591 # so return no tax rates.
1592 return () if !$part_pkg_taxproduct;
1594 # convert the taxproduct to the tax classes that might apply to it in
1596 @taxclassnums = map { $_->taxclassnum }
1597 grep { $_->taxable eq 'Y' } # why do we need this?
1598 $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1600 return unless @taxclassnums;
1602 # then look up the actual tax_rate entries
1603 warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1605 my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1606 my @taxes = qsearch({ 'table' => 'tax_rate',
1607 'hashref' => { 'geocode' => $geocode,
1608 'data_vendor' => $vendor,
1610 'extra_sql' => $extra_sql,
1612 warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1618 =item part_pkg_discount
1620 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1625 sub part_pkg_discount {
1627 qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1630 =item part_pkg_usage
1632 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1637 sub part_pkg_usage {
1639 qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
1644 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1645 PLAN is the object's I<plan> field. There should be better docs
1646 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1652 my $plan = $self->plan;
1654 cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1658 return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1659 my $class = ref($self). "::$plan";
1660 warn "reblessing $self into $class" if $DEBUG > 1;
1663 bless($self, $class) unless $@;
1668 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1669 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1671 #fallback that return 0 for old legacy packages with no plan
1672 sub calc_remain { 0; }
1673 sub calc_units { 0; }
1675 #fallback for everything not based on flat.pm
1676 sub recur_temporality { 'upcoming'; }
1677 sub calc_cancel { 0; }
1679 #fallback for everything except bulk.pm
1680 sub hide_svc_detail { 0; }
1682 #fallback for packages that can't/won't summarize usage
1683 sub sum_usage { 0; }
1685 =item recur_cost_permonth CUST_PKG
1687 recur_cost divided by freq (only supported for monthly and longer frequencies)
1691 sub recur_cost_permonth {
1692 my($self, $cust_pkg) = @_;
1693 return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1694 sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
1697 =item cust_bill_pkg_recur CUST_PKG
1699 Actual recurring charge for the specified customer package from customer's most
1704 sub cust_bill_pkg_recur {
1705 my($self, $cust_pkg) = @_;
1706 my $cust_bill_pkg = qsearchs({
1707 'table' => 'cust_bill_pkg',
1708 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1709 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum,
1710 'recur' => { op=>'>', value=>'0' },
1712 'order_by' => 'ORDER BY cust_bill._date DESC,
1713 cust_bill_pkg.sdate DESC
1716 }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1717 $cust_bill_pkg->recur;
1720 =item unit_setup CUST_PKG
1722 Returns the setup fee for one unit of the package.
1727 my ($self, $cust_pkg) = @_;
1728 $self->option('setup_fee') || 0;
1733 unit_setup minus setup_cost
1739 $self->unit_setup(@_) - ($self->setup_cost || 0);
1742 =item recur_margin_permonth
1744 base_recur_permonth minus recur_cost_permonth
1748 sub recur_margin_permonth {
1750 $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
1753 =item intro_end PACKAGE
1755 Takes an L<FS::cust_pkg> object. If this plan has an introductory rate,
1756 returns the expected date the intro period will end. If there is no intro
1765 =item format OPTION DATA
1767 Returns data formatted according to the function 'format' described
1768 in the plan info. Returns DATA if no such function exists.
1773 my ($self, $option, $data) = (shift, shift, shift);
1774 if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1775 &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1781 =item parse OPTION DATA
1783 Returns data parsed according to the function 'parse' described
1784 in the plan info. Returns DATA if no such function exists.
1789 my ($self, $option, $data) = (shift, shift, shift);
1790 if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1791 &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1801 =head1 CLASS METHODS
1809 # Used by FS::Upgrade to migrate to a new database.
1811 sub _upgrade_data { # class method
1812 my($class, %opts) = @_;
1814 warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1816 my @part_pkg = qsearch({
1817 'table' => 'part_pkg',
1818 'extra_sql' => "WHERE ". join(' OR ',
1819 'plan IS NULL', "plan = '' ",
1823 foreach my $part_pkg (@part_pkg) {
1825 unless ( $part_pkg->plan ) {
1826 $part_pkg->plan('flat');
1832 # the rest can be done asynchronously
1835 sub queueable_upgrade {
1836 # now upgrade to the explicit custom flag
1838 my $search = FS::Cursor->new({
1839 'table' => 'part_pkg',
1840 'hashref' => { disabled => 'Y', custom => '' },
1841 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1845 while (my $part_pkg = $search->fetch) {
1846 my $new = new FS::part_pkg { $part_pkg->hash };
1848 my $comment = $part_pkg->comment;
1849 $comment =~ s/^\(CUSTOM\) //;
1850 $comment = '(none)' unless $comment =~ /\S/;
1851 $new->comment($comment);
1853 my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1854 my $primary = $part_pkg->svcpart;
1855 my $options = { $part_pkg->options };
1857 my $error = $new->replace( $part_pkg,
1858 'pkg_svc' => $pkg_svc,
1859 'primary_svc' => $primary,
1860 'options' => $options,
1863 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
1870 # set family_pkgpart on any packages that don't have it
1871 $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
1872 while (my $part_pkg = $search->fetch) {
1873 $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
1874 my $error = $part_pkg->SUPER::replace;
1876 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
1883 my @part_pkg_option = qsearch('part_pkg_option',
1884 { 'optionname' => 'unused_credit',
1887 foreach my $old_opt (@part_pkg_option) {
1888 my $pkgpart = $old_opt->pkgpart;
1889 my $error = $old_opt->delete;
1890 die $error if $error;
1892 foreach (qw(unused_credit_cancel unused_credit_change)) {
1893 my $new_opt = new FS::part_pkg_option {
1894 'pkgpart' => $pkgpart,
1898 $error = $new_opt->insert;
1899 die $error if $error;
1903 # migrate use_disposition_taqua and use_disposition to disposition_in
1904 @part_pkg_option = qsearch('part_pkg_option',
1905 { 'optionname' => { op => 'LIKE',
1906 value => 'use_disposition%',
1910 my %newopts = map { $_->pkgpart => $_ }
1911 qsearch('part_pkg_option', { 'optionname' => 'disposition_in', } );
1912 foreach my $old_opt (@part_pkg_option) {
1913 my $pkgpart = $old_opt->pkgpart;
1914 my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
1916 my $error = $old_opt->delete;
1917 die $error if $error;
1919 if ( exists($newopts{$pkgpart}) ) {
1920 my $opt = $newopts{$pkgpart};
1921 $opt->optionvalue($opt->optionvalue.",$newval");
1922 $error = $opt->replace;
1923 die $error if $error;
1925 my $new_opt = new FS::part_pkg_option {
1926 'pkgpart' => $pkgpart,
1927 'optionname' => 'disposition_in',
1928 'optionvalue' => $newval,
1930 $error = $new_opt->insert;
1931 die $error if $error;
1932 $newopts{$pkgpart} = $new_opt;
1936 # set any package with FCC voice lines to the "VoIP with broadband" category
1937 # for backward compatibility
1939 # recover from a bad upgrade bug
1940 my $upgrade = 'part_pkg_fcc_voip_class_FIX';
1941 if (!FS::upgrade_journal->is_done($upgrade)) {
1942 my $bad_upgrade = qsearchs('upgrade_journal',
1943 { upgrade => 'part_pkg_fcc_voip_class' }
1945 if ( $bad_upgrade ) {
1946 my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
1947 ' AND history_date > '.($bad_upgrade->_date - 3600);
1948 my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
1951 'table' => 'h_part_pkg_option',
1953 'extra_sql' => "$where AND history_action = 'delete'",
1954 'order_by' => 'ORDER BY history_date ASC',
1956 my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
1959 'table' => 'h_pkg_svc',
1961 'extra_sql' => "$where AND history_action = 'replace_old'",
1962 'order_by' => 'ORDER BY history_date ASC',
1965 foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
1966 my $pkgpart ||= $deleted->pkgpart;
1967 $opt{$pkgpart} ||= {
1973 if ( $deleted->isa('FS::part_pkg_option') ) {
1974 $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
1976 my $svcpart = $deleted->svcpart;
1977 $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
1978 $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
1979 $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
1982 foreach my $pkgpart (keys %opt) {
1983 my $part_pkg = FS::part_pkg->by_key($pkgpart);
1984 my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
1986 die "error recovering damaged pkgpart $pkgpart:\n$error\n";
1989 } # $bad_upgrade exists
1990 else { # do the original upgrade, but correctly this time
1991 my @part_pkg = qsearch('part_pkg', {
1992 fcc_ds0s => { op => '>', value => 0 },
1993 fcc_voip_class => ''
1995 foreach my $part_pkg (@part_pkg) {
1996 $part_pkg->set(fcc_voip_class => 2);
1997 my @pkg_svc = $part_pkg->pkg_svc;
1998 my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
1999 my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc;
2000 my $error = $part_pkg->replace(
2001 $part_pkg->replace_old,
2002 options => { $part_pkg->options },
2003 pkg_svc => \%quantity,
2004 hidden_svc => \%hidden,
2005 primary_svc => ($part_pkg->svcpart || ''),
2007 die $error if $error;
2010 FS::upgrade_journal->set_done($upgrade);
2013 # remove custom flag from one-time charge packages that were accidentally
2015 $search = FS::Cursor->new({
2016 'table' => 'part_pkg',
2017 'hashref' => { 'freq' => '0',
2019 'family_pkgpart' => { op => '!=', value => '' },
2021 'addl_from' => ' JOIN
2022 (select pkgpart from cust_pkg group by pkgpart having count(*) = 1)
2023 AS singular_pkg USING (pkgpart)',
2025 my @fields = grep { $_ ne 'pkgpart'
2027 and $_ ne 'disabled' } FS::part_pkg->fields;
2028 PKGPART: while (my $part_pkg = $search->fetch) {
2029 # can't merge the package back into its parent (too late for that)
2030 # but we can remove the custom flag if it's not actually customized,
2031 # i.e. nothing has been changed.
2033 my $family_pkgpart = $part_pkg->family_pkgpart;
2034 next PKGPART if $family_pkgpart == $part_pkg->pkgpart;
2035 my $parent_pkg = FS::part_pkg->by_key($family_pkgpart);
2036 foreach my $field (@fields) {
2037 if ($part_pkg->get($field) ne $parent_pkg->get($field)) {
2041 # options have to be identical too
2042 # but links, FCC options, discount plans, and usage packages can't be
2043 # changed through the "modify charge" UI, so skip them
2044 my %newopt = $part_pkg->options;
2045 my %oldopt = $parent_pkg->options;
2046 OPTION: foreach my $option (keys %newopt) {
2047 if (delete $newopt{$option} ne delete $oldopt{$option}) {
2051 if (keys(%newopt) or keys(%oldopt)) {
2054 # okay, now replace it
2055 warn "Removing custom flag from part_pkg#".$part_pkg->pkgpart."\n";
2056 $part_pkg->set('custom', '');
2057 my $error = $part_pkg->replace;
2058 die $error if $error;
2064 =item curuser_pkgs_sql
2066 Returns an SQL fragment for searching for packages the current user can
2067 use, either via part_pkg.agentnum directly, or via agent type (see
2072 sub curuser_pkgs_sql {
2075 $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2079 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2081 Returns an SQL fragment for searching for packages the provided agent or agents
2082 can use, either via part_pkg.agentnum directly, or via agent type (see
2087 sub agent_pkgs_sql {
2088 my $class = shift; #i'm a class method, not a sub (the question is... why??)
2089 my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2091 $class->_pkgs_sql(@agentnums); #is this why
2096 my( $class, @agentnums ) = @_;
2097 my $agentnums = join(',', @agentnums);
2101 ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2102 OR ( agentnum IS NULL
2103 AND EXISTS ( SELECT 1
2105 LEFT JOIN agent_type USING ( typenum )
2106 LEFT JOIN agent AS typeagent USING ( typenum )
2107 WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2108 AND typeagent.agentnum IN ($agentnums)
2126 #false laziness w/part_export & cdr
2128 foreach my $INC ( @INC ) {
2129 warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2130 foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2131 warn "attempting to load plan info from $file\n" if $DEBUG;
2132 $file =~ /\/(\w+)\.pm$/ or do {
2133 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2137 my $info = eval "use FS::part_pkg::$mod; ".
2138 "\\%FS::part_pkg::$mod\::info;";
2140 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2143 unless ( keys %$info ) {
2144 warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2147 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2148 #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2149 # warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2152 $info{$mod} = $info;
2153 $info->{'weight'} ||= 0; # quiet warnings
2157 # copy one level deep to allow replacement of fields and fieldorder
2158 tie %plans, 'Tie::IxHash',
2159 map { my %infohash = %{ $info{$_} };
2161 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2164 # inheritance of plan options
2165 foreach my $name (keys(%info)) {
2166 if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2167 warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2168 delete $plans{$name};
2171 my $parents = $info{$name}->{'inherit_fields'} || [];
2172 my (%fields, %field_exists, @fieldorder);
2173 foreach my $parent ($name, @$parents) {
2174 if ( !exists($info{$parent}) ) {
2175 warn "$name tried to inherit from nonexistent '$parent'\n";
2178 %fields = ( # avoid replacing existing fields
2179 %{ $info{$parent}->{'fields'} || {} },
2182 foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2184 next if $field_exists{$_};
2185 $field_exists{$_} = 1;
2186 # allow inheritors to remove inherited fields from the fieldorder
2187 push @fieldorder, $_ if !exists($fields{$_}) or
2188 !exists($fields{$_}->{'disabled'});
2191 $plans{$name}->{'fields'} = \%fields;
2192 $plans{$name}->{'fieldorder'} = \@fieldorder;
2202 =head1 NEW PLAN CLASSES
2204 A module should be added in FS/FS/part_pkg/ Eventually, an example may be
2205 found in eg/plan_template.pm. Until then, it is suggested that you use the
2206 other modules in FS/FS/part_pkg/ as a guide.
2210 The delete method is unimplemented.
2212 setup and recur semantics are not yet defined (and are implemented in
2213 FS::cust_bill. hmm.). now they're deprecated and need to go.
2217 part_pkg_taxrate is Pg specific
2219 replace should be smarter about managing the related tables (options, pkg_svc)
2223 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2224 schema.html from the base documentation.