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 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_vendor;
32 use FS::part_pkg_currency;
33 use FS::part_svc_link;
37 $skip_pkg_svc_hack = 0;
41 FS::part_pkg - Object methods for part_pkg objects
47 $record = new FS::part_pkg \%hash
48 $record = new FS::part_pkg { 'column' => 'value' };
50 $custom_record = $template_record->clone;
52 $error = $record->insert;
54 $error = $new_record->replace($old_record);
56 $error = $record->delete;
58 $error = $record->check;
60 @pkg_svc = $record->pkg_svc;
62 $svcnum = $record->svcpart;
63 $svcnum = $record->svcpart( 'svc_acct' );
67 An FS::part_pkg object represents a package definition. FS::part_pkg
68 inherits from FS::Record. The following fields are currently supported:
72 =item pkgpart - primary key (assigned automatically for new package definitions)
74 =item pkg - Text name of this package definition (customer-viewable)
76 =item comment - Text name of this package definition (non-customer-viewable)
78 =item classnum - Optional package class (see L<FS::pkg_class>)
80 =item promo_code - Promotional code
82 =item setup - Setup fee expression (deprecated)
84 =item freq - Frequency of recurring fee
86 =item recur - Recurring fee expression (deprecated)
88 =item setuptax - Setup fee tax exempt flag, empty or `Y'
90 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
92 =item taxclass - Tax class
94 =item plan - Price plan
96 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
98 =item disabled - Disabled flag, empty or `Y'
100 =item custom - Custom flag, empty or `Y'
102 =item setup_cost - for cost tracking
104 =item recur_cost - for cost tracking
106 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
108 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
110 =item agentnum - Optional agentnum (see L<FS::agent>)
112 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
114 =item fcc_voip_class - Which column of FCC form 477 part II.B this package
117 =item successor - Foreign key for the part_pkg that replaced this record.
118 If this record is not obsolete, will be null.
120 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
121 ancestor of this record. If this record is not a successor to another
122 part_pkg, will be equal to pkgpart.
124 =item delay_start - Number of days to delay package start, by default
126 =item start_on_hold - 'Y' to suspend this package immediately when it is
127 ordered. The package will not start billing or have a setup fee charged
128 until it is manually unsuspended.
130 =item change_to_pkgpart - When this package is ordered, schedule a future
131 package change. The 'expire_months' field will determine when the package
134 =item expire_months - Number of months until this package expires (or changes
137 =item adjourn_months - Number of months until this package becomes suspended.
139 =item contract_end_months - Number of months until the package's contract
150 Creates a new package definition. To add the package definition to
151 the database, see L<"insert">.
155 sub table { 'part_pkg'; }
159 An alternate constructor. Creates a new package definition by duplicating
160 an existing definition. A new pkgpart is assigned and the custom flag is
161 set to Y. To add the package definition to the database, see L<"insert">.
167 my $class = ref($self);
168 my %hash = $self->hash;
169 $hash{'pkgpart'} = '';
170 $hash{'custom'} = 'Y';
171 #new FS::part_pkg ( \%hash ); # ?
172 new $class ( \%hash ); # ?
175 =item insert [ , OPTION => VALUE ... ]
177 Adds this package definition to the database. If there is an error,
178 returns the error, otherwise returns false.
180 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
181 I<custnum_ref> and I<options>.
183 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
184 values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
185 be set to a hashref of svcparts and flag values ('Y' or '') to set the
186 'hidden' field in these records.
188 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
189 FS::pkg_svc record will be updated.
191 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
192 record itself), the object will be updated to point to this package definition.
194 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
195 the scalar will be updated with the custnum value from the cust_pkg record.
197 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
198 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
199 records will be inserted.
201 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
202 records will be inserted.
204 If I<part_pkg_currency> is set to a hashref of options (with the keys as
205 option_CURRENCY), appropriate FS::part_pkg::currency records will be inserted.
212 warn "FS::part_pkg::insert called on $self with options ".
213 join(', ', map "$_=>$options{$_}", keys %options)
216 local $SIG{HUP} = 'IGNORE';
217 local $SIG{INT} = 'IGNORE';
218 local $SIG{QUIT} = 'IGNORE';
219 local $SIG{TERM} = 'IGNORE';
220 local $SIG{TSTP} = 'IGNORE';
221 local $SIG{PIPE} = 'IGNORE';
223 my $oldAutoCommit = $FS::UID::AutoCommit;
224 local $FS::UID::AutoCommit = 0;
227 warn " inserting part_pkg record" if $DEBUG;
228 my $error = $self->SUPER::insert( $options{options} );
230 $dbh->rollback if $oldAutoCommit;
235 if ( $self->get('family_pkgpart') eq '' ) {
236 $self->set('family_pkgpart' => $self->pkgpart);
237 $error = $self->SUPER::replace;
239 $dbh->rollback if $oldAutoCommit;
244 warn " inserting part_pkg_taxoverride records" if $DEBUG;
245 my %overrides = %{ $options{'tax_overrides'} || {} };
246 foreach my $usage_class ( keys %overrides ) {
248 ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
249 ? $overrides{$usage_class}
251 my @overrides = (grep "$_", split(',', $override) );
252 my $error = $self->process_m2m (
253 'link_table' => 'part_pkg_taxoverride',
254 'target_table' => 'tax_class',
255 'hashref' => { 'usage_class' => $usage_class },
256 'params' => \@overrides,
259 $dbh->rollback if $oldAutoCommit;
264 warn " inserting part_pkg_currency records" if $DEBUG;
265 my %part_pkg_currency = %{ $options{'part_pkg_currency'} || {} };
266 foreach my $key ( keys %part_pkg_currency ) {
267 $key =~ /^(.+)_([A-Z]{3})$/ or next;
268 my( $optionname, $currency ) = ( $1, $2 );
269 if ( $part_pkg_currency{$key} =~ /^\s*$/ ) {
270 if ( $self->option($optionname) == 0 ) {
271 $part_pkg_currency{$key} = '0';
273 $dbh->rollback if $oldAutoCommit;
274 ( my $thing = $optionname ) =~ s/_/ /g;
275 return ucfirst($thing). " $currency is required";
278 my $part_pkg_currency = new FS::part_pkg_currency {
279 'pkgpart' => $self->pkgpart,
280 'optionname' => $optionname,
281 'currency' => $currency,
282 'optionvalue' => $part_pkg_currency{$key},
284 my $error = $part_pkg_currency->insert;
286 $dbh->rollback if $oldAutoCommit;
291 unless ( $skip_pkg_svc_hack ) {
293 warn " inserting pkg_svc records" if $DEBUG;
294 my $pkg_svc = $options{'pkg_svc'} || {};
295 my $hidden_svc = $options{'hidden_svc'} || {};
296 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
297 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
299 ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
303 my $pkg_svc = new FS::pkg_svc( {
304 'pkgpart' => $self->pkgpart,
305 'svcpart' => $part_svc->svcpart,
306 'quantity' => $quantity,
307 'primary_svc' => $primary_svc,
308 'hidden' => $hidden_svc->{$part_svc->svcpart},
310 my $error = $pkg_svc->insert;
312 $dbh->rollback if $oldAutoCommit;
317 my $error = $self->check_pkg_svc(%options);
319 $dbh->rollback if $oldAutoCommit;
325 if ( $options{'cust_pkg'} ) {
326 warn " updating cust_pkg record " if $DEBUG;
328 ref($options{'cust_pkg'})
329 ? $options{'cust_pkg'}
330 : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
331 ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
332 if $options{'custnum_ref'};
333 my %hash = $old_cust_pkg->hash;
334 $hash{'pkgpart'} = $self->pkgpart,
335 my $new_cust_pkg = new FS::cust_pkg \%hash;
336 local($FS::cust_pkg::disable_agentcheck) = 1;
337 my $error = $new_cust_pkg->replace($old_cust_pkg);
339 $dbh->rollback if $oldAutoCommit;
340 return "Error modifying cust_pkg record: $error";
344 if ( $options{'part_pkg_vendor'} ) {
345 while ( my ($exportnum, $vendor_pkg_id) =
346 each %{ $options{part_pkg_vendor} }
349 my $ppv = new FS::part_pkg_vendor( {
350 'pkgpart' => $self->pkgpart,
351 'exportnum' => $exportnum,
352 'vendor_pkg_id' => $vendor_pkg_id,
354 my $error = $ppv->insert;
356 $dbh->rollback if $oldAutoCommit;
357 return "Error inserting part_pkg_vendor record: $error";
362 if ( $options{fcc_options} ) {
363 warn " updating fcc options " if $DEBUG;
364 $self->set_fcc_options( $options{fcc_options} );
367 warn " committing transaction" if $DEBUG and $oldAutoCommit;
368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
375 Currently unimplemented.
380 return "Can't (yet?) delete package definitions.";
381 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
384 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
386 Replaces OLD_RECORD with this one in the database. If there is an error,
387 returns the error, otherwise returns false.
389 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>
392 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
393 values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
394 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
395 'hidden' field in these records. I<bulk_skip> can be set to a hashref of
396 svcparts and flag values ('Y' or '') to set the 'bulk_skip' field in those
399 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
400 FS::pkg_svc record will be updated.
402 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
405 If I<part_pkg_currency> is set to a hashref of options (with the keys as
406 option_CURRENCY), appropriate FS::part_pkg::currency records will be replaced.
413 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
418 ( ref($_[0]) eq 'HASH' )
422 $options->{options} = { $old->options } unless defined($options->{options});
424 warn "FS::part_pkg::replace called on $new to replace $old with options".
425 join(', ', map "$_ => ". $options->{$_}, keys %$options)
428 local $SIG{HUP} = 'IGNORE';
429 local $SIG{INT} = 'IGNORE';
430 local $SIG{QUIT} = 'IGNORE';
431 local $SIG{TERM} = 'IGNORE';
432 local $SIG{TSTP} = 'IGNORE';
433 local $SIG{PIPE} = 'IGNORE';
435 my $oldAutoCommit = $FS::UID::AutoCommit;
436 local $FS::UID::AutoCommit = 0;
439 my $conf = new FS::Conf;
440 if ( $conf->exists('part_pkg-lineage') ) {
441 if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
442 qw(setup_fee recur_fee) #others? config?
445 warn " superseding package" if $DEBUG;
447 my $error = $new->supersede($old, %$options);
449 $dbh->rollback if $oldAutoCommit;
453 warn " committing transaction" if $DEBUG and $oldAutoCommit;
454 $dbh->commit if $oldAutoCommit;
461 #plandata shit stays in replace for upgrades until after 2.0 (or edit
463 warn " saving legacy plandata" if $DEBUG;
464 my $plandata = $new->get('plandata');
465 $new->set('plandata', '');
467 warn " deleting old part_pkg_option records" if $DEBUG;
468 foreach my $part_pkg_option ( $old->part_pkg_option ) {
469 my $error = $part_pkg_option->delete;
471 $dbh->rollback if $oldAutoCommit;
476 warn " replacing part_pkg record" if $DEBUG;
477 my $error = $new->SUPER::replace($old, $options->{options} );
479 $dbh->rollback if $oldAutoCommit;
483 warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
484 foreach my $part_pkg_option (
485 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
486 return "illegal plandata: $plandata";
488 new FS::part_pkg_option {
489 'pkgpart' => $new->pkgpart,
494 split("\n", $plandata)
496 my $error = $part_pkg_option->insert;
498 $dbh->rollback if $oldAutoCommit;
503 #trivial nit: not the most efficient to delete and reinsert
504 warn " deleting old part_pkg_currency records" if $DEBUG;
505 foreach my $part_pkg_currency ( $old->part_pkg_currency ) {
506 my $error = $part_pkg_currency->delete;
508 $dbh->rollback if $oldAutoCommit;
509 return "error deleting part_pkg_currency record: $error";
513 warn " inserting new part_pkg_currency records" if $DEBUG;
514 my %part_pkg_currency = %{ $options->{'part_pkg_currency'} || {} };
515 foreach my $key ( keys %part_pkg_currency ) {
516 $key =~ /^(.+)_([A-Z]{3})$/ or next;
517 my $part_pkg_currency = new FS::part_pkg_currency {
518 'pkgpart' => $new->pkgpart,
521 'optionvalue' => $part_pkg_currency{$key},
523 my $error = $part_pkg_currency->insert;
525 $dbh->rollback if $oldAutoCommit;
526 return "error inserting part_pkg_currency record: $error";
531 warn " replacing pkg_svc records" if $DEBUG;
532 my $pkg_svc = $options->{'pkg_svc'};
533 my $hidden_svc = $options->{'hidden_svc'} || {};
534 my $bulk_skip = $options->{'bulk_skip'} || {};
535 if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
537 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
538 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
539 my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
540 my $bulk_skip = $bulk_skip->{$part_svc->svcpart} || '';
542 ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
543 && $options->{'primary_svc'} == $part_svc->svcpart
548 my $old_pkg_svc = qsearchs('pkg_svc', {
549 'pkgpart' => $old->pkgpart,
550 'svcpart' => $part_svc->svcpart,
553 my $old_quantity = 0;
554 my $old_primary_svc = '';
556 my $old_bulk_skip = '';
557 if ( $old_pkg_svc ) {
558 $old_quantity = $old_pkg_svc->quantity;
559 $old_primary_svc = $old_pkg_svc->primary_svc
560 if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
561 $old_hidden = $old_pkg_svc->hidden;
562 $old_bulk_skip = $old_pkg_svc->old_bulk_skip;
565 next unless $old_quantity != $quantity
566 || $old_primary_svc ne $primary_svc
567 || $old_hidden ne $hidden
568 || $old_bulk_skip ne $bulk_skip;
570 my $new_pkg_svc = new FS::pkg_svc( {
571 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
572 'pkgpart' => $new->pkgpart,
573 'svcpart' => $part_svc->svcpart,
574 'quantity' => $quantity,
575 'primary_svc' => $primary_svc,
577 'bulk_skip' => $bulk_skip,
579 my $error = $old_pkg_svc
580 ? $new_pkg_svc->replace($old_pkg_svc)
581 : $new_pkg_svc->insert;
583 $dbh->rollback if $oldAutoCommit;
588 my $error = $new->check_pkg_svc(%$options);
590 $dbh->rollback if $oldAutoCommit;
594 } #if $options->{pkg_svc}
596 my @part_pkg_vendor = $old->part_pkg_vendor;
597 my @current_exportnum = ();
598 if ( $options->{'part_pkg_vendor'} ) {
599 my($exportnum,$vendor_pkg_id);
600 while ( ($exportnum,$vendor_pkg_id)
601 = each %{$options->{'part_pkg_vendor'}} ) {
603 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
604 if($exportnum == $part_pkg_vendor->exportnum
605 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
606 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
607 my $error = $part_pkg_vendor->replace;
609 $dbh->rollback if $oldAutoCommit;
610 return "Error replacing part_pkg_vendor record: $error";
615 elsif($exportnum == $part_pkg_vendor->exportnum
616 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
621 unless ( $noinsert ) {
622 my $ppv = new FS::part_pkg_vendor( {
623 'pkgpart' => $new->pkgpart,
624 'exportnum' => $exportnum,
625 'vendor_pkg_id' => $vendor_pkg_id,
627 my $error = $ppv->insert;
629 $dbh->rollback if $oldAutoCommit;
630 return "Error inserting part_pkg_vendor record: $error";
633 push @current_exportnum, $exportnum;
636 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
637 unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
638 my $error = $part_pkg_vendor->delete;
640 $dbh->rollback if $oldAutoCommit;
641 return "Error deleting part_pkg_vendor record: $error";
646 # propagate changes to certain core fields
647 if ( $conf->exists('part_pkg-lineage') ) {
648 warn " propagating changes to family" if $DEBUG;
649 my $error = $new->propagate($old);
651 $dbh->rollback if $oldAutoCommit;
656 if ( $options->{fcc_options} ) {
657 warn " updating fcc options " if $DEBUG;
658 $new->set_fcc_options( $options->{fcc_options} );
661 warn " committing transaction" if $DEBUG and $oldAutoCommit;
662 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
668 Checks all fields to make sure this is a valid package definition. If
669 there is an error, returns the error, otherwise returns false. Called by the
670 insert and replace methods.
676 warn "FS::part_pkg::check called on $self" if $DEBUG;
678 for (qw(setup recur plandata)) {
679 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
680 return "Use of $_ field is deprecated; set a plan and options: ".
682 if length($self->get($_));
686 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
687 my $error = $self->ut_number('freq');
688 return $error if $error;
690 $self->freq =~ /^(\d+[hdw]?)$/
691 or return "Illegal or empty freq: ". $self->freq;
695 my @null_agentnum_right = ( 'Edit global package definitions' );
696 push @null_agentnum_right, 'One-time charge'
697 if $self->freq =~ /^0/;
698 push @null_agentnum_right, 'Customize customer package'
699 if $self->disabled eq 'Y'; #good enough
701 my $error = $self->ut_numbern('pkgpart')
702 || $self->ut_text('pkg')
703 || $self->ut_textn('comment')
704 || $self->ut_textn('promo_code')
705 || $self->ut_alphan('plan')
706 || $self->ut_flag('setuptax')
707 || $self->ut_flag('recurtax')
708 || $self->ut_textn('taxclass')
709 || $self->ut_flag('disabled')
710 || $self->ut_flag('custom')
711 || $self->ut_flag('no_auto')
712 || $self->ut_flag('recur_show_zero')
713 || $self->ut_flag('setup_show_zero')
714 || $self->ut_flag('start_on_hold')
715 #|| $self->ut_moneyn('setup_cost')
716 #|| $self->ut_moneyn('recur_cost')
717 || $self->ut_floatn('setup_cost')
718 || $self->ut_floatn('recur_cost')
719 || $self->ut_floatn('pay_weight')
720 || $self->ut_floatn('credit_weight')
721 || $self->ut_numbern('taxproductnum')
722 || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
723 || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
724 || $self->ut_foreign_keyn('taxproductnum',
725 'part_pkg_taxproduct',
729 ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
730 : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
732 || $self->ut_numbern('fcc_ds0s')
733 || $self->ut_numbern('fcc_voip_class')
734 || $self->ut_numbern('delay_start')
735 || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
736 || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
737 || $self->ut_numbern('expire_months')
738 || $self->ut_numbern('adjourn_months')
739 || $self->ut_numbern('contract_end_months')
740 || $self->ut_numbern('change_to_pkgpart')
741 || $self->ut_foreign_keyn('change_to_pkgpart', 'part_pkg', 'pkgpart')
742 || $self->ut_alphan('agent_pkgpartid')
743 || $self->SUPER::check
745 return $error if $error;
747 return 'Unknown plan '. $self->plan
748 unless exists($plans{$self->plan});
750 my $conf = new FS::Conf;
751 return 'Taxclass is required'
752 if ! $self->taxclass && $conf->exists('require_taxclasses');
759 Checks pkg_svc records as a whole (for part_svc_link dependencies).
761 If there is an error, returns the error, otherwise returns false.
766 my( $self, %opt ) = @_;
768 my $agentnum = $self->agentnum;
770 my %pkg_svc = map { $_->svcpart => $_ } $self->pkg_svc;
772 foreach my $svcpart ( keys %pkg_svc ) {
774 foreach my $part_svc_link ( $self->part_svc_link(
775 'src_svcpart' => $svcpart,
776 'link_type' => 'part_pkg_restrict',
780 return $part_svc_link->dst_svc. ' must be included with '.
781 $part_svc_link->src_svc
782 unless $pkg_svc{ $part_svc_link->dst_svcpart };
787 return '' if $opt{part_pkg_restrict_soft_override};
789 foreach my $svcpart ( keys %pkg_svc ) {
791 foreach my $part_svc_link ( $self->part_svc_link(
792 'src_svcpart' => $svcpart,
793 'link_type' => 'part_pkg_restrict_soft',
796 return $part_svc_link->dst_svc. ' is suggested with '.
797 $part_svc_link->src_svc
798 unless $pkg_svc{ $part_svc_link->dst_svcpart };
806 =item part_svc_link OPTION => VALUE ...
808 Returns the service dependencies (see L<FS::part_svc_link>) for the given
809 search options, taking into account this package definition's agent.
811 Available options are any field in part_svc_link. Typically used options are
812 src_svcpart and link_type.
817 FS::part_svc_link->by_agentnum( shift->agentnum, @_ );
820 =item supersede OLD [, OPTION => VALUE ... ]
822 Inserts this package as a successor to the package OLD. All options are as
823 for C<insert>. After inserting, disables OLD and sets the new package as its
829 my ($new, $old, %options) = @_;
832 $new->set('pkgpart' => '');
833 $new->set('family_pkgpart' => $old->family_pkgpart);
834 warn " inserting successor package\n" if $DEBUG;
835 $error = $new->insert(%options);
836 return $error if $error;
838 warn " disabling superseded package\n" if $DEBUG;
839 $old->set('successor' => $new->pkgpart);
840 $old->set('disabled' => 'Y');
841 $error = $old->SUPER::replace; # don't change its options/pkg_svc records
842 return $error if $error;
844 warn " propagating changes to family" if $DEBUG;
845 $new->propagate($old);
850 If any of certain fields have changed from OLD to this package, then,
851 for all packages in the same lineage as this one, sets those fields
852 to their values in this package.
856 my @propagate_fields = (
857 qw( pkg classnum setup_cost recur_cost taxclass
858 setuptax recurtax pay_weight credit_weight
866 map { $_ => $new->get($_) }
867 grep { $new->get($_) ne $old->get($_) }
871 my @part_pkg = qsearch('part_pkg', {
872 'family_pkgpart' => $new->family_pkgpart
875 foreach my $part_pkg ( @part_pkg ) {
876 my $pkgpart = $part_pkg->pkgpart;
877 next if $pkgpart == $new->pkgpart; # don't modify $new
878 warn " propagating to pkgpart $pkgpart\n" if $DEBUG;
879 foreach ( keys %fields ) {
880 $part_pkg->set($_, $fields{$_});
882 # SUPER::replace to avoid changing non-core fields
883 my $error = $part_pkg->SUPER::replace;
884 push @error, "pkgpart $pkgpart: $error"
890 =item set_fcc_options HASHREF
892 Sets the FCC options on this package definition to the values specified
897 sub set_fcc_options {
899 my $pkgpart = $self->pkgpart;
907 my %existing_num = map { $_->fccoptionname => $_->num }
908 qsearch('part_pkg_fcc_option', { pkgpart => $pkgpart });
910 local $FS::Record::nowarn_identical = 1;
911 # set up params for process_o2m
914 foreach my $name (keys %$options ) {
915 $params->{ "num$i" } = $existing_num{$name} || '';
916 $params->{ "num$i".'_fccoptionname' } = $name;
917 $params->{ "num$i".'_optionvalue' } = $options->{$name};
922 table => 'part_pkg_fcc_option',
923 fields => [qw( fccoptionname optionvalue )],
928 =item pkg_locale LOCALE
930 Returns a customer-viewable string representing this package for the given
931 locale, from the part_pkg_msgcat table. If the given locale is empty or no
932 localized string is found, returns the base pkg field.
937 my( $self, $locale ) = @_;
938 return $self->pkg unless $locale;
939 my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
940 $part_pkg_msgcat->pkg;
943 =item part_pkg_msgcat LOCALE
945 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
949 sub part_pkg_msgcat {
950 my( $self, $locale ) = @_;
951 qsearchs( 'part_pkg_msgcat', {
952 pkgpart => $self->pkgpart,
957 =item pkg_comment [ OPTION => VALUE... ]
959 Returns an (internal) string representing this package. Currently,
960 "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
961 future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
964 If the option nopkgpart is true then the "pkgpart: ' is omitted.
972 #$self->pkg. ' - '. $self->comment;
973 #$self->pkg. ' ('. $self->comment. ')';
974 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
975 my $custom_comment = $self->custom_comment(%opt);
976 $pre. $self->pkg. ( $custom_comment ? " - $custom_comment" : '' );
979 #without price info (so without hitting the DB again)
980 sub pkg_comment_only {
984 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
985 my $comment = $self->comment;
986 $pre. $self->pkg. ( $comment ? " - $comment" : '' );
989 sub price_info { # safety, in case a part_pkg hasn't defined price_info
995 my $price_info = $self->price_info(@_);
996 ( $self->custom ? '(CUSTOM) ' : '' ).
998 ( ($self->custom || $self->comment) ? ' - ' : '' ).
999 ($price_info || 'No charge');
1002 sub pkg_price_info {
1004 $self->pkg. ' - '. ($self->price_info || 'No charge');
1009 Returns the package class, as an FS::pkg_class object, or the empty string
1010 if there is no package class.
1012 =item addon_pkg_class
1014 Returns the add-on package class, as an FS::pkg_class object, or the empty
1015 string if there is no add-on package class.
1019 sub addon_pkg_class {
1021 if ( $self->addon_classnum ) {
1022 qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
1030 Returns the package category name, or the empty string if there is no package
1037 my $pkg_class = $self->pkg_class;
1039 ? $pkg_class->categoryname
1045 Returns the package class name, or the empty string if there is no package
1052 my $pkg_class = $self->pkg_class;
1054 ? $pkg_class->classname
1058 =item addon_classname
1060 Returns the add-on package class name, or the empty string if there is no
1061 add-on package class.
1065 sub addon_classname {
1067 my $pkg_class = $self->addon_pkg_class;
1069 ? $pkg_class->classname
1075 Returns the associated agent for this event, if any, as an FS::agent object.
1077 =item pkg_svc [ HASHREF | OPTION => VALUE ]
1079 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
1080 definition (with non-zero quantity).
1082 One option is available, I<disable_linked>. If set true it will return the
1083 services for this package definition alone, omitting services from any add-on
1090 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
1098 # #sort { $b->primary cmp $a->primary }
1099 # grep { $_->quantity }
1100 # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1102 my $opt = ref($_[0]) ? $_[0] : { @_ };
1103 my %pkg_svc = map { $_->svcpart => $_ }
1104 grep { $_->quantity }
1105 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
1107 unless ( $opt->{disable_linked} ) {
1108 foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
1109 my @pkg_svc = grep { $_->quantity }
1110 qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
1111 foreach my $pkg_svc ( @pkg_svc ) {
1112 if ( $pkg_svc{$pkg_svc->svcpart} ) {
1113 my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
1114 $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
1116 $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
1126 =item svcpart [ SVCDB ]
1128 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
1129 associated with this package definition (see L<FS::pkg_svc>). Returns
1130 false if there not a primary service definition or exactly one service
1131 definition with quantity 1, or if SVCDB is specified and does not match the
1132 svcdb of the service definition. SVCDB can be specified as a scalar table
1133 name, such as 'svc_acct', or as an arrayref of possible table names.
1138 my $pkg_svc = shift->_primary_pkg_svc(@_);
1139 $pkg_svc ? $pkg_svc->svcpart : '';
1142 =item part_svc [ SVCDB ]
1144 Like the B<svcpart> method, but returns the FS::part_svc object (see
1150 my $pkg_svc = shift->_primary_pkg_svc(@_);
1151 $pkg_svc ? $pkg_svc->part_svc : '';
1154 sub _primary_pkg_svc {
1157 my $svcdb = scalar(@_) ? shift : [];
1158 $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
1159 my %svcdb = map { $_=>1 } @$svcdb;
1162 grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
1165 my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
1166 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
1168 return '' if scalar(@pkg_svc) != 1;
1172 =item svcpart_unique_svcdb SVCDB
1174 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
1175 SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
1176 false if there not a primary service definition for SVCDB or there are multiple
1177 service definitions for SVCDB.
1181 sub svcpart_unique_svcdb {
1182 my( $self, $svcdb ) = @_;
1183 my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
1184 return '' if scalar(@svcdb_pkg_svc) != 1;
1185 $svcdb_pkg_svc[0]->svcpart;
1190 Returns a list of the acceptable payment types for this package. Eventually
1191 this should come out of a database table and be editable, but currently has the
1192 following logic instead:
1194 If the package is free, the single item B<BILL> is
1195 returned, otherwise, the single item B<CARD> is returned.
1197 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
1203 if ( $self->is_free ) {
1212 Returns true if this package is free.
1218 if ( $self->can('is_free_options') ) {
1219 not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1220 map { $self->option($_) }
1221 $self->is_free_options;
1223 warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1224 "provides neither is_free_options nor is_free method; returning false";
1229 # whether the plan allows discounts to be applied to this package
1230 sub can_discount { 0; }
1232 # whether the plan allows changing the start date
1233 sub can_start_date {
1235 $self->start_on_hold ? 0 : 1;
1238 # whether the plan supports part_pkg_usageprice add-ons (a specific kind of
1239 # pre-selectable usage pricing, there's others this doesn't refer to)
1240 sub can_usageprice { 0; }
1242 # the delay start date if present
1243 sub delay_start_date {
1246 my $delay = $self->delay_start or return '';
1248 # avoid timelocal silliness
1249 my $dt = DateTime->today(time_zone => 'local');
1250 $dt->add(days => $delay);
1254 sub can_currency_exchange { 0; }
1257 # moved to FS::Misc to make this accessible to other packages
1259 FS::Misc::pkg_freqs();
1264 Returns an english representation of the I<freq> field, such as "monthly",
1265 "weekly", "semi-annually", etc.
1271 my $freq = $self->freq;
1273 #my $freqs_href = $self->freqs_href;
1274 my $freqs_href = freqs_href();
1276 if ( exists($freqs_href->{$freq}) ) {
1277 $freqs_href->{$freq};
1279 my $interval = 'month';
1280 if ( $freq =~ /^(\d+)([hdw])$/ ) {
1281 my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1282 $interval = $interval{$2};
1287 "every $freq ${interval}s";
1292 =item add_freq TIMESTAMP [ FREQ ]
1294 Adds a billing period of some frequency to the provided timestamp and
1295 returns the resulting timestamp, or -1 if the frequency could not be
1296 parsed (shouldn't happen). By default, the frequency of this package
1297 will be used; to override this, pass a different frequency as a second
1303 my( $self, $date, $freq ) = @_;
1304 $freq = $self->freq unless $freq;
1306 #change this bit to use Date::Manip? CAREFUL with timezones (see
1307 # mailing list archive)
1308 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1310 if ( $freq =~ /^\d+$/ ) {
1312 until ( $mon < 12 ) { $mon -= 12; $year++; }
1314 $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1316 } elsif ( $freq =~ /^(\d+)w$/ ) {
1318 $mday += $weeks * 7;
1319 } elsif ( $freq =~ /^(\d+)d$/ ) {
1322 } elsif ( $freq =~ /^(\d+)h$/ ) {
1329 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1334 For backwards compatibility, returns the plandata field as well as all options
1335 from FS::part_pkg_option.
1341 carp "plandata is deprecated";
1343 $self->SUPER::plandata(@_);
1345 my $plandata = $self->get('plandata');
1346 my %options = $self->options;
1347 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1352 =item part_pkg_vendor
1354 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1355 L<FS::part_pkg_vendor>).
1357 =item vendor_pkg_ids
1359 Returns a list of vendor/external package ids by exportnum
1363 sub vendor_pkg_ids {
1365 map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1368 =item part_pkg_option
1370 Returns all options as FS::part_pkg_option objects (see
1371 L<FS::part_pkg_option>).
1375 Returns a list of option names and values suitable for assigning to a hash.
1381 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1384 =item option OPTIONNAME [ QUIET ]
1386 Returns the option value for the given name, or the empty string. If a true
1387 value is passed as the second argument, warnings about missing the option
1393 my( $self, $opt, $ornull ) = @_;
1395 #cache: was pulled up in the original part_pkg query
1396 if ( $opt =~ /^(setup|recur)_fee$/ && defined($self->hashref->{"_$opt"}) ) {
1397 return $self->hashref->{"_$opt"};
1400 cluck "$self -> option: searching for $opt"
1402 my $part_pkg_option =
1403 qsearchs('part_pkg_option', {
1404 pkgpart => $self->pkgpart,
1407 return $part_pkg_option->optionvalue if $part_pkg_option;
1409 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1410 split("\n", $self->get('plandata') );
1411 return $plandata{$opt} if exists $plandata{$opt};
1413 # check whether the option is defined in plan info (if so, don't warn)
1414 if (exists $plans{ $self->plan }->{fields}->{$opt}) {
1417 cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1418 "not found in options or plandata!\n"
1424 =item part_pkg_currency [ CURRENCY ]
1426 Returns all currency options as FS::part_pkg_currency objects (see
1427 L<FS::part_pkg_currency>), or, if a currency is specified, only return the
1428 objects for that currency.
1432 sub part_pkg_currency {
1434 my %hash = ( 'pkgpart' => $self->pkgpart );
1435 $hash{'currency'} = shift if @_;
1436 qsearch('part_pkg_currency', \%hash );
1439 =item part_pkg_currency_options CURRENCY
1441 Returns a list of option names and values from FS::part_pkg_currency for the
1446 sub part_pkg_currency_options {
1448 map { $_->optionname => $_->optionvalue } $self->part_pkg_currency(shift);
1451 =item part_pkg_currency_option CURRENCY OPTIONNAME
1453 Returns the option value for the given name and currency.
1457 sub part_pkg_currency_option {
1458 my( $self, $currency, $optionname ) = @_;
1459 my $part_pkg_currency =
1460 qsearchs('part_pkg_currency', { 'pkgpart' => $self->pkgpart,
1461 'currency' => $currency,
1462 'optionname' => $optionname,
1465 #fatal if not found? that works for our use cases from
1466 #part_pkg/currency_fixed, but isn't how we would typically/expect the method
1467 #to behave. have to catch it there if we change it here...
1468 or die "Unknown price for ". $self->pkg_comment. " in $currency\n";
1470 $part_pkg_currency->optionvalue;
1473 =item fcc_option OPTIONNAME
1475 Returns the FCC 477 report option value for the given name, or the empty
1481 my ($self, $name) = @_;
1482 my $part_pkg_fcc_option =
1483 qsearchs('part_pkg_fcc_option', {
1484 pkgpart => $self->pkgpart,
1485 fccoptionname => $name,
1487 $part_pkg_fcc_option ? $part_pkg_fcc_option->optionvalue : '';
1492 Returns all FCC 477 report options for this package, as a hash-like list.
1498 map { $_->fccoptionname => $_->optionvalue }
1499 qsearch('part_pkg_fcc_option', { pkgpart => $self->pkgpart });
1502 =item bill_part_pkg_link
1504 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1508 sub bill_part_pkg_link {
1509 shift->_part_pkg_link('bill', @_);
1512 =item svc_part_pkg_link
1514 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1518 sub svc_part_pkg_link {
1519 shift->_part_pkg_link('svc', @_);
1522 =item supp_part_pkg_link
1524 Returns the associated part_pkg_link records of type 'supp' (supplemental
1529 sub supp_part_pkg_link {
1530 shift->_part_pkg_link('supp', @_);
1533 sub _part_pkg_link {
1534 my( $self, $type ) = @_;
1535 qsearch({ table => 'part_pkg_link',
1536 hashref => { 'src_pkgpart' => $self->pkgpart,
1537 'link_type' => $type,
1538 #protection against infinite recursive links
1539 'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1541 order_by => "ORDER BY hidden",
1545 sub self_and_bill_linked {
1546 shift->_self_and_linked('bill', @_);
1549 sub self_and_svc_linked {
1550 shift->_self_and_linked('svc', @_);
1553 sub _self_and_linked {
1554 my( $self, $type, $hidden ) = @_;
1558 foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1559 $self->_part_pkg_link($type) ) )
1561 $_->hidden($hidden) if $hidden;
1568 =item part_pkg_taxoverride [ CLASS ]
1570 Returns all associated FS::part_pkg_taxoverride objects (see
1571 L<FS::part_pkg_taxoverride>). Limits the returned set to those
1572 of class CLASS if defined. Class may be one of 'setup', 'recur',
1573 the empty string (default), or a usage class number (see L<FS::usage_class>).
1574 When a class is specified, the empty string class (default) is returned
1575 if no more specific values exist.
1579 sub part_pkg_taxoverride {
1583 my $hashref = { 'pkgpart' => $self->pkgpart };
1584 $hashref->{'usage_class'} = $class if defined($class);
1585 my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1587 unless ( scalar(@overrides) || !defined($class) || !$class ){
1588 $hashref->{'usage_class'} = '';
1589 @overrides = qsearch('part_pkg_taxoverride', $hashref );
1595 =item has_taxproduct
1597 Returns true if this package has any taxproduct associated with it.
1601 sub has_taxproduct {
1604 $self->taxproductnum ||
1605 scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1606 keys %{ {$self->options} }
1612 =item taxproduct [ CLASS ]
1614 Returns the associated tax product for this package definition (see
1615 L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
1616 the usage classnum (see L<FS::usage_class>). Returns the default
1617 tax product for this record if the more specific CLASS value does
1626 my $part_pkg_taxproduct;
1628 my $taxproductnum = $self->taxproductnum;
1630 my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1631 $taxproductnum = $class_taxproductnum
1632 if $class_taxproductnum
1635 $part_pkg_taxproduct =
1636 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1638 unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1639 $taxproductnum = $self->taxproductnum;
1640 $part_pkg_taxproduct =
1641 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1644 $part_pkg_taxproduct;
1647 =item taxproduct_description [ CLASS ]
1649 Returns the description of the associated tax product for this package
1650 definition (see L<FS::part_pkg_taxproduct>).
1654 sub taxproduct_description {
1656 my $part_pkg_taxproduct = $self->taxproduct(@_);
1657 $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1661 =item tax_rates DATA_PROVIDER, GEOCODE, [ CLASS ]
1663 Returns the tax table entries (L<FS::tax_rate> objects) that apply to this
1664 package in the location specified by GEOCODE, for usage class CLASS (one of
1665 'setup', 'recur', null, or a C<usage_class> number).
1671 my ($vendor, $geocode, $class) = @_;
1672 # if this part_pkg is overridden into a specific taxclass, get that class
1673 my @taxclassnums = map { $_->taxclassnum }
1674 $self->part_pkg_taxoverride($class);
1675 # otherwise, get its tax product category
1676 if (!@taxclassnums) {
1677 my $part_pkg_taxproduct = $self->taxproduct($class);
1678 # If this isn't defined, then the class has no taxproduct designation,
1679 # so return no tax rates.
1680 return () if !$part_pkg_taxproduct;
1682 # convert the taxproduct to the tax classes that might apply to it in
1684 @taxclassnums = map { $_->taxclassnum }
1685 grep { $_->taxable eq 'Y' } # why do we need this?
1686 $part_pkg_taxproduct->part_pkg_taxrate($geocode);
1688 return unless @taxclassnums;
1690 # then look up the actual tax_rate entries
1691 warn "Found taxclassnum values of ". join(',', @taxclassnums) ."\n"
1693 my $extra_sql = "AND taxclassnum IN (". join(',', @taxclassnums) . ")";
1694 my @taxes = qsearch({ 'table' => 'tax_rate',
1695 'hashref' => { 'geocode' => $geocode,
1696 'data_vendor' => $vendor,
1698 'extra_sql' => $extra_sql,
1700 warn "Found taxes ". join(',', map {$_->taxnum} @taxes) ."\n"
1706 =item part_pkg_discount
1708 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1711 =item part_pkg_usage
1713 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1718 Returns the automatic transfer target for this package, or an empty string
1725 my $pkgpart = $self->change_to_pkgpart or return '';
1726 FS::part_pkg->by_key($pkgpart);
1731 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1732 PLAN is the object's I<plan> field. There should be better docs
1733 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1739 my $plan = $self->plan;
1741 cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1745 return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1746 my $class = ref($self). "::$plan";
1747 warn "reblessing $self into $class" if $DEBUG > 1;
1750 bless($self, $class) unless $@;
1754 =item calc_setup CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1756 =item calc_recur CUST_PKG START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1758 Calculates and returns the setup or recurring fees, respectively, for this
1759 package. Implementation is in the FS::part_pkg:* module specific to this price
1762 Adds invoicing details to the passed-in DETAILS_ARRAYREF
1764 Options are passed as a hashref. Available options:
1770 Frequency override (for calc_recur)
1774 This option is filled in by the method rather than controlling its operation.
1775 It is an arrayref. Applicable discounts will be added to the arrayref, as
1776 L<FS::cust_bill_pkg_discount|FS::cust_bill_pkg_discount records>.
1780 For package add-ons, is the base L<FS::part_pkg|package definition>, otherwise
1781 no different than pkgpart.
1783 =item precommit_hooks
1785 This option is filled in by the method rather than controlling its operation.
1786 It is an arrayref. Anonymous coderefs will be added to the arrayref. They
1787 need to be called before completing the billing operation. For calc_recur
1790 =item increment_next_bill
1792 Increment the next bill date (boolean, for calc_recur). Typically true except
1793 for particular situations.
1797 This option is filled in by the method rather than controlling its operation.
1798 It indicates a deferred setup fee that is billed at calc_recur time (see price
1799 plan option prorate_defer_bill).
1803 Note: Don't calculate prices when not actually billing the package. For that,
1804 see the L</base_setup|base_setup> and L</base_recur|base_recur> methods.
1809 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1810 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1812 =item calc_remain CUST_PKG [ OPTION => VALUE ... ]
1814 Calculates and returns the remaining value to be credited upon package
1815 suspension, change, or cancellation, if enabled.
1817 Options are passed as a list of keys and values. Available options:
1823 Override for the current time
1825 =item cust_credit_source_bill_pkg
1827 This option is filled in by the method rather than controlling its operation.
1829 L<FS::cust_credit_source_bill_pkg|FS::cust_credit_source_bill_pkg> records will
1830 be added to the arrayref indicating the specific line items and amounts which
1831 are the source of this remaining credit.
1835 Note: Don't calculate prices when not actually suspending or cancelling the
1840 #fallback that returns 0 for old legacy packages with no plan
1841 sub calc_remain { 0; }
1843 =item calc_units CUST_PKG
1845 This returns the number of provisioned svc_phone records, or, of the package
1846 count_available_phones option is set, the number available to be provisoined
1851 #fallback that returns 0 for old legacy packages with no plan
1852 sub calc_units { 0; }
1854 #fallback for everything not based on flat.pm
1855 sub recur_temporality { 'upcoming'; }
1857 =item calc_cancel START_DATE DETAILS_ARRAYREF OPTIONS_HASHREF
1859 Runs any necessary billing on cancellation: another recurring cycle for
1860 recur_temporailty 'preceding' pacakges with the bill_recur_on_cancel option
1861 set (calc_recur), or, any outstanding usage for pacakges with the
1862 bill_usage_on_cancel option set (calc_usage).
1866 #fallback for everything not based on flat.pm, doesn't do this yet (which is
1867 #okay, nothing of ours not based on flat.pm does usage-on-cancel billing
1868 sub calc_cancel { 0; }
1870 #fallback for everything except bulk.pm
1871 sub hide_svc_detail { 0; }
1873 #fallback for packages that can't/won't summarize usage
1874 sub sum_usage { 0; }
1876 =item recur_cost_permonth CUST_PKG
1878 recur_cost divided by freq (only supported for monthly and longer frequencies)
1882 sub recur_cost_permonth {
1883 my($self, $cust_pkg) = @_;
1884 return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1885 sprintf('%.2f', ($self->recur_cost || 0) / $self->freq );
1888 =item cust_bill_pkg_recur CUST_PKG
1890 Actual recurring charge for the specified customer package from customer's most
1895 sub cust_bill_pkg_recur {
1896 my($self, $cust_pkg) = @_;
1897 my $cust_bill_pkg = qsearchs({
1898 'table' => 'cust_bill_pkg',
1899 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1900 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum,
1901 'recur' => { op=>'>', value=>'0' },
1903 'order_by' => 'ORDER BY cust_bill._date DESC,
1904 cust_bill_pkg.sdate DESC
1907 }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1908 $cust_bill_pkg->recur;
1911 =item unit_setup CUST_PKG
1913 Returns the setup fee for one unit of the package.
1918 my ($self, $cust_pkg) = @_;
1919 $self->option('setup_fee') || 0;
1924 unit_setup minus setup_cost
1930 $self->unit_setup(@_) - ($self->setup_cost || 0);
1933 =item recur_margin_permonth
1935 base_recur_permonth minus recur_cost_permonth
1939 sub recur_margin_permonth {
1941 $self->base_recur_permonth(@_) - $self->recur_cost_permonth(@_);
1944 =item format OPTION DATA
1946 Returns data formatted according to the function 'format' described
1947 in the plan info. Returns DATA if no such function exists.
1952 my ($self, $option, $data) = (shift, shift, shift);
1953 if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1954 &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1960 =item parse OPTION DATA
1962 Returns data parsed according to the function 'parse' described
1963 in the plan info. Returns DATA if no such function exists.
1968 my ($self, $option, $data) = (shift, shift, shift);
1969 if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1970 &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1980 =head1 CLASS METHODS
1988 # Used by FS::Upgrade to migrate to a new database.
1990 sub _upgrade_data { # class method
1991 my($class, %opts) = @_;
1993 warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1995 my @part_pkg = qsearch({
1996 'table' => 'part_pkg',
1997 'extra_sql' => "WHERE ". join(' OR ',
1998 'plan IS NULL', "plan = '' ",
2002 foreach my $part_pkg (@part_pkg) {
2004 unless ( $part_pkg->plan ) {
2005 $part_pkg->plan('flat');
2012 # Convert RADIUS accounting usage metrics from megabytes to gigabytes
2014 my $upgrade = 'part_pkg_gigabyte_usage';
2015 if (!FS::upgrade_journal->is_done($upgrade)) {
2016 foreach my $part_pkg (qsearch('part_pkg',
2017 { plan => 'sqlradacct_hour' })
2020 my $pkgpart = $part_pkg->pkgpart;
2022 foreach my $opt (qsearch('part_pkg_option',
2023 { 'optionname' => { op => 'LIKE',
2024 value => 'recur_included_%',
2026 pkgpart => $pkgpart,
2029 next if $opt->optionname eq 'recur_included_hours'; # unfortunately named field
2030 next if $opt->optionvalue == 0;
2032 $opt->optionvalue($opt->optionvalue / 1024);
2034 my $error = $opt->replace;
2035 die $error if $error;
2038 foreach my $opt (qsearch('part_pkg_option',
2039 { 'optionname' => { op => 'LIKE',
2040 value => 'recur_%_charge',
2042 pkgpart => $pkgpart,
2044 $opt->optionvalue($opt->optionvalue * 1024);
2046 my $error = $opt->replace;
2047 die $error if $error;
2051 FS::upgrade_journal->set_done($upgrade);
2054 # the rest can be done asynchronously
2057 sub queueable_upgrade {
2058 # now upgrade to the explicit custom flag
2060 my $search = FS::Cursor->new({
2061 'table' => 'part_pkg',
2062 'hashref' => { disabled => 'Y', custom => '' },
2063 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
2067 while (my $part_pkg = $search->fetch) {
2068 my $new = new FS::part_pkg { $part_pkg->hash };
2070 my $comment = $part_pkg->comment;
2071 $comment =~ s/^\(CUSTOM\) //;
2072 $comment = '(none)' unless $comment =~ /\S/;
2073 $new->comment($comment);
2075 my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
2076 my $primary = $part_pkg->svcpart;
2077 my $options = { $part_pkg->options };
2079 my $error = $new->replace( $part_pkg,
2080 'pkg_svc' => $pkg_svc,
2081 'primary_svc' => $primary,
2082 'options' => $options,
2085 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2092 # set family_pkgpart on any packages that don't have it
2093 $search = FS::Cursor->new('part_pkg', { 'family_pkgpart' => '' });
2094 while (my $part_pkg = $search->fetch) {
2095 $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
2096 my $error = $part_pkg->SUPER::replace;
2098 warn "pkgpart#".$part_pkg->pkgpart.": $error\n";
2105 my @part_pkg_option = qsearch('part_pkg_option',
2106 { 'optionname' => 'unused_credit',
2109 foreach my $old_opt (@part_pkg_option) {
2110 my $pkgpart = $old_opt->pkgpart;
2111 my $error = $old_opt->delete;
2112 die $error if $error;
2114 foreach (qw(unused_credit_cancel unused_credit_change)) {
2115 my $new_opt = new FS::part_pkg_option {
2116 'pkgpart' => $pkgpart,
2120 $error = $new_opt->insert;
2121 die $error if $error;
2125 # migrate use_disposition_taqua and use_disposition to disposition_in
2126 @part_pkg_option = qsearch('part_pkg_option',
2127 { 'optionname' => { op => 'LIKE',
2128 value => 'use_disposition%',
2132 my %newopts = map { $_->pkgpart => $_ }
2133 qsearch('part_pkg_option', { 'optionname' => 'disposition_in', } );
2134 foreach my $old_opt (@part_pkg_option) {
2135 my $pkgpart = $old_opt->pkgpart;
2136 my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
2138 my $error = $old_opt->delete;
2139 die $error if $error;
2141 if ( exists($newopts{$pkgpart}) ) {
2142 my $opt = $newopts{$pkgpart};
2143 $opt->optionvalue($opt->optionvalue.",$newval");
2144 $error = $opt->replace;
2145 die $error if $error;
2147 my $new_opt = new FS::part_pkg_option {
2148 'pkgpart' => $pkgpart,
2149 'optionname' => 'disposition_in',
2150 'optionvalue' => $newval,
2152 $error = $new_opt->insert;
2153 die $error if $error;
2154 $newopts{$pkgpart} = $new_opt;
2158 # set any package with FCC voice lines to the "VoIP with broadband" category
2159 # for backward compatibility
2161 # recover from a bad upgrade bug
2162 my $upgrade = 'part_pkg_fcc_voip_class_FIX';
2163 if (!FS::upgrade_journal->is_done($upgrade)) {
2164 my $bad_upgrade = qsearchs('upgrade_journal',
2165 { upgrade => 'part_pkg_fcc_voip_class' }
2167 if ( $bad_upgrade ) {
2168 my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
2169 ' AND history_date > '.($bad_upgrade->_date - 3600);
2170 my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
2173 'table' => 'h_part_pkg_option',
2175 'extra_sql' => "$where AND history_action = 'delete'",
2176 'order_by' => 'ORDER BY history_date ASC',
2178 my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
2181 'table' => 'h_pkg_svc',
2183 'extra_sql' => "$where AND history_action = 'replace_old'",
2184 'order_by' => 'ORDER BY history_date ASC',
2187 foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
2188 my $pkgpart ||= $deleted->pkgpart;
2189 $opt{$pkgpart} ||= {
2195 if ( $deleted->isa('FS::part_pkg_option') ) {
2196 $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
2198 my $svcpart = $deleted->svcpart;
2199 $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
2200 $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
2201 $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
2204 foreach my $pkgpart (keys %opt) {
2205 my $part_pkg = FS::part_pkg->by_key($pkgpart);
2206 my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
2208 die "error recovering damaged pkgpart $pkgpart:\n$error\n";
2211 } # $bad_upgrade exists
2212 else { # do the original upgrade, but correctly this time
2213 my @part_pkg = qsearch('part_pkg', {
2214 fcc_ds0s => { op => '>', value => 0 },
2215 fcc_voip_class => ''
2217 foreach my $part_pkg (@part_pkg) {
2218 $part_pkg->set(fcc_voip_class => 2);
2219 my @pkg_svc = $part_pkg->pkg_svc;
2220 my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
2221 my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc;
2222 my $error = $part_pkg->replace(
2223 $part_pkg->replace_old,
2224 options => { $part_pkg->options },
2225 pkg_svc => \%quantity,
2226 hidden_svc => \%hidden,
2227 primary_svc => ($part_pkg->svcpart || ''),
2229 die $error if $error;
2232 FS::upgrade_journal->set_done($upgrade);
2235 # migrate adjourn_months, expire_months, and contract_end_months to
2237 foreach my $field (qw(adjourn_months expire_months contract_end_months)) {
2238 foreach my $option (qsearch('part_pkg_option', { optionname => $field })) {
2239 my $part_pkg = $option->part_pkg;
2240 my $error = $option->delete;
2241 if ( $option->optionvalue and $part_pkg->get($field) eq '' ) {
2242 $part_pkg->set($field, $option->optionvalue);
2243 $error ||= $part_pkg->replace;
2245 die $error if $error;
2250 =item curuser_pkgs_sql
2252 Returns an SQL fragment for searching for packages the current user can
2253 use, either via part_pkg.agentnum directly, or via agent type (see
2258 sub curuser_pkgs_sql {
2261 $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
2265 =item agent_pkgs_sql AGENT | AGENTNUM, ...
2267 Returns an SQL fragment for searching for packages the provided agent or agents
2268 can use, either via part_pkg.agentnum directly, or via agent type (see
2273 sub agent_pkgs_sql {
2274 my $class = shift; #i'm a class method, not a sub (the question is... why??)
2275 my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
2277 $class->_pkgs_sql(@agentnums); #is this why
2282 my( $class, @agentnums ) = @_;
2283 my $agentnums = join(',', @agentnums);
2287 ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
2288 OR ( agentnum IS NULL
2289 AND EXISTS ( SELECT 1
2291 LEFT JOIN agent_type USING ( typenum )
2292 LEFT JOIN agent AS typeagent USING ( typenum )
2293 WHERE type_pkgs.pkgpart = part_pkg.pkgpart
2294 AND typeagent.agentnum IN ($agentnums)
2312 #false laziness w/part_export & cdr
2314 foreach my $INC ( @INC ) {
2315 warn "globbing $INC/FS/part_pkg/[a-z]*.pm\n" if $DEBUG;
2316 foreach my $file ( glob("$INC/FS/part_pkg/[a-z]*.pm") ) {
2317 warn "attempting to load plan info from $file\n" if $DEBUG;
2318 $file =~ /\/(\w+)\.pm$/ or do {
2319 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
2323 my $info = eval "use FS::part_pkg::$mod; ".
2324 "\\%FS::part_pkg::$mod\::info;";
2326 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
2329 unless ( keys %$info ) {
2330 warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
2333 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
2334 #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
2335 # warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
2338 $info{$mod} = $info;
2339 $info->{'weight'} ||= 0; # quiet warnings
2343 # copy one level deep to allow replacement of fields and fieldorder
2344 tie %plans, 'Tie::IxHash',
2345 map { my %infohash = %{ $info{$_} };
2347 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
2350 # inheritance of plan options
2351 foreach my $name (keys(%info)) {
2352 if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
2353 warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
2354 delete $plans{$name};
2357 my $parents = $info{$name}->{'inherit_fields'} || [];
2358 my (%fields, %field_exists, @fieldorder);
2359 foreach my $parent ($name, @$parents) {
2360 if ( !exists($info{$parent}) ) {
2361 warn "$name tried to inherit from nonexistent '$parent'\n";
2364 %fields = ( # avoid replacing existing fields
2365 %{ $info{$parent}->{'fields'} || {} },
2368 foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
2370 next if $field_exists{$_};
2371 $field_exists{$_} = 1;
2372 # allow inheritors to remove inherited fields from the fieldorder
2373 push @fieldorder, $_ if !exists($fields{$_}) or
2374 !exists($fields{$_}->{'disabled'});
2377 $plans{$name}->{'fields'} = \%fields;
2378 $plans{$name}->{'fieldorder'} = \@fieldorder;
2388 =head1 NEW PLAN CLASSES
2390 A module should be added in FS/FS/part_pkg/ Eventually, an example may be
2391 found in eg/plan_template.pm. Until then, it is suggested that you use the
2392 other modules in FS/FS/part_pkg/ as a guide.
2396 The delete method is unimplemented.
2398 setup and recur semantics are not yet defined (and are implemented in
2399 FS::cust_bill. hmm.). now they're deprecated and need to go.
2403 part_pkg_taxrate is Pg specific
2405 replace should be smarter about managing the related tables (options, pkg_svc)
2409 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
2410 schema.html from the base documentation.