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 use Carp qw(carp cluck confess);
7 use Scalar::Util qw( blessed );
8 use Time::Local qw( timelocal timelocal_nocheck );
11 use FS::Record qw( qsearch qsearchs dbh dbdef );
17 use FS::part_pkg_option;
20 use FS::part_pkg_msgcat;
21 use FS::part_pkg_taxrate;
22 use FS::part_pkg_taxoverride;
23 use FS::part_pkg_taxproduct;
24 use FS::part_pkg_link;
25 use FS::part_pkg_discount;
26 use FS::part_pkg_usage;
27 use FS::part_pkg_vendor;
31 $skip_pkg_svc_hack = 0;
35 FS::part_pkg - Object methods for part_pkg objects
41 $record = new FS::part_pkg \%hash
42 $record = new FS::part_pkg { 'column' => 'value' };
44 $custom_record = $template_record->clone;
46 $error = $record->insert;
48 $error = $new_record->replace($old_record);
50 $error = $record->delete;
52 $error = $record->check;
54 @pkg_svc = $record->pkg_svc;
56 $svcnum = $record->svcpart;
57 $svcnum = $record->svcpart( 'svc_acct' );
61 An FS::part_pkg object represents a package definition. FS::part_pkg
62 inherits from FS::Record. The following fields are currently supported:
66 =item pkgpart - primary key (assigned automatically for new package definitions)
68 =item pkg - Text name of this package definition (customer-viewable)
70 =item comment - Text name of this package definition (non-customer-viewable)
72 =item classnum - Optional package class (see L<FS::pkg_class>)
74 =item promo_code - Promotional code
76 =item setup - Setup fee expression (deprecated)
78 =item freq - Frequency of recurring fee
80 =item recur - Recurring fee expression (deprecated)
82 =item setuptax - Setup fee tax exempt flag, empty or `Y'
84 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
86 =item taxclass - Tax class
88 =item plan - Price plan
90 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
92 =item disabled - Disabled flag, empty or `Y'
94 =item custom - Custom flag, empty or `Y'
96 =item setup_cost - for cost tracking
98 =item recur_cost - for cost tracking
100 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
102 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
104 =item agentnum - Optional agentnum (see L<FS::agent>)
106 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
108 =item fcc_voip_class - Which column of FCC form 477 part II.B this package
111 =item successor - Foreign key for the part_pkg that replaced this record.
112 If this record is not obsolete, will be null.
114 =item family_pkgpart - Foreign key for the part_pkg that was the earliest
115 ancestor of this record. If this record is not a successor to another
116 part_pkg, will be equal to pkgpart.
118 =item delay_start - Number of days to delay package start, by default
128 Creates a new package definition. To add the package definition to
129 the database, see L<"insert">.
133 sub table { 'part_pkg'; }
137 An alternate constructor. Creates a new package definition by duplicating
138 an existing definition. A new pkgpart is assigned and the custom flag is
139 set to Y. To add the package definition to the database, see L<"insert">.
145 my $class = ref($self);
146 my %hash = $self->hash;
147 $hash{'pkgpart'} = '';
148 $hash{'custom'} = 'Y';
149 #new FS::part_pkg ( \%hash ); # ?
150 new $class ( \%hash ); # ?
153 =item insert [ , OPTION => VALUE ... ]
155 Adds this package definition to the database. If there is an error,
156 returns the error, otherwise returns false.
158 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
159 I<custnum_ref> and I<options>.
161 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
162 values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
163 be set to a hashref of svcparts and flag values ('Y' or '') to set the
164 'hidden' field in these records.
166 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
167 FS::pkg_svc record will be updated.
169 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
170 record itself), the object will be updated to point to this package definition.
172 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
173 the scalar will be updated with the custnum value from the cust_pkg record.
175 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
176 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
177 records will be inserted.
179 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
180 records will be inserted.
187 warn "FS::part_pkg::insert called on $self with options ".
188 join(', ', map "$_=>$options{$_}", keys %options)
191 local $SIG{HUP} = 'IGNORE';
192 local $SIG{INT} = 'IGNORE';
193 local $SIG{QUIT} = 'IGNORE';
194 local $SIG{TERM} = 'IGNORE';
195 local $SIG{TSTP} = 'IGNORE';
196 local $SIG{PIPE} = 'IGNORE';
198 my $oldAutoCommit = $FS::UID::AutoCommit;
199 local $FS::UID::AutoCommit = 0;
202 warn " inserting part_pkg record" if $DEBUG;
203 my $error = $self->SUPER::insert( $options{options} );
205 $dbh->rollback if $oldAutoCommit;
210 if ( $self->get('family_pkgpart') eq '' ) {
211 $self->set('family_pkgpart' => $self->pkgpart);
212 $error = $self->SUPER::replace;
214 $dbh->rollback if $oldAutoCommit;
219 my $conf = new FS::Conf;
220 if ( $conf->exists('agent_defaultpkg') ) {
221 warn " agent_defaultpkg set; allowing all agents to purchase package"
223 foreach my $agent_type ( qsearch('agent_type', {} ) ) {
224 my $type_pkgs = new FS::type_pkgs({
225 'typenum' => $agent_type->typenum,
226 'pkgpart' => $self->pkgpart,
228 my $error = $type_pkgs->insert;
230 $dbh->rollback if $oldAutoCommit;
236 warn " inserting part_pkg_taxoverride records" if $DEBUG;
237 my %overrides = %{ $options{'tax_overrides'} || {} };
238 foreach my $usage_class ( keys %overrides ) {
240 ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
241 ? $overrides{$usage_class}
243 my @overrides = (grep "$_", split(',', $override) );
244 my $error = $self->process_m2m (
245 'link_table' => 'part_pkg_taxoverride',
246 'target_table' => 'tax_class',
247 'hashref' => { 'usage_class' => $usage_class },
248 'params' => \@overrides,
251 $dbh->rollback if $oldAutoCommit;
256 unless ( $skip_pkg_svc_hack ) {
258 warn " inserting pkg_svc records" if $DEBUG;
259 my $pkg_svc = $options{'pkg_svc'} || {};
260 my $hidden_svc = $options{'hidden_svc'} || {};
261 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
262 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
264 ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
268 my $pkg_svc = new FS::pkg_svc( {
269 'pkgpart' => $self->pkgpart,
270 'svcpart' => $part_svc->svcpart,
271 'quantity' => $quantity,
272 'primary_svc' => $primary_svc,
273 'hidden' => $hidden_svc->{$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 warn " committing transaction" if $DEBUG and $oldAutoCommit;
322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
329 Currently unimplemented.
334 return "Can't (yet?) delete package definitions.";
335 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
338 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
340 Replaces OLD_RECORD with this one in the database. If there is an error,
341 returns the error, otherwise returns false.
343 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>
346 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
347 values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
348 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
349 'hidden' field in these records.
351 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
352 FS::pkg_svc record will be updated.
354 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
362 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
367 ( ref($_[0]) eq 'HASH' )
371 $options->{options} = { $old->options } unless defined($options->{options});
373 warn "FS::part_pkg::replace called on $new to replace $old with options".
374 join(', ', map "$_ => ". $options->{$_}, keys %$options)
377 local $SIG{HUP} = 'IGNORE';
378 local $SIG{INT} = 'IGNORE';
379 local $SIG{QUIT} = 'IGNORE';
380 local $SIG{TERM} = 'IGNORE';
381 local $SIG{TSTP} = 'IGNORE';
382 local $SIG{PIPE} = 'IGNORE';
384 my $oldAutoCommit = $FS::UID::AutoCommit;
385 local $FS::UID::AutoCommit = 0;
388 my $conf = new FS::Conf;
389 if ( $conf->exists('part_pkg-lineage') ) {
390 if ( grep { $options->{options}->{$_} ne $old->option($_, 1) }
391 qw(setup_fee recur_fee) #others? config?
394 warn " superseding package" if $DEBUG;
396 my $error = $new->supersede($old, %$options);
398 $dbh->rollback if $oldAutoCommit;
402 warn " committing transaction" if $DEBUG and $oldAutoCommit;
403 $dbh->commit if $oldAutoCommit;
410 #plandata shit stays in replace for upgrades until after 2.0 (or edit
412 warn " saving legacy plandata" if $DEBUG;
413 my $plandata = $new->get('plandata');
414 $new->set('plandata', '');
416 warn " deleting old part_pkg_option records" if $DEBUG;
417 foreach my $part_pkg_option ( $old->part_pkg_option ) {
418 my $error = $part_pkg_option->delete;
420 $dbh->rollback if $oldAutoCommit;
425 warn " replacing part_pkg record" if $DEBUG;
426 my $error = $new->SUPER::replace($old, $options->{options} );
428 $dbh->rollback if $oldAutoCommit;
432 warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
433 foreach my $part_pkg_option (
434 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
435 return "illegal plandata: $plandata";
437 new FS::part_pkg_option {
438 'pkgpart' => $new->pkgpart,
443 split("\n", $plandata)
445 my $error = $part_pkg_option->insert;
447 $dbh->rollback if $oldAutoCommit;
452 warn " replacing pkg_svc records" if $DEBUG;
453 my $pkg_svc = $options->{'pkg_svc'};
454 my $hidden_svc = $options->{'hidden_svc'} || {};
455 if ( $pkg_svc ) { # if it wasn't passed, don't change existing pkg_svcs
456 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
457 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
458 my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
460 ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
461 && $options->{'primary_svc'} == $part_svc->svcpart
466 my $old_pkg_svc = qsearchs('pkg_svc', {
467 'pkgpart' => $old->pkgpart,
468 'svcpart' => $part_svc->svcpart,
471 my $old_quantity = 0;
472 my $old_primary_svc = '';
474 if ( $old_pkg_svc ) {
475 $old_quantity = $old_pkg_svc->quantity;
476 $old_primary_svc = $old_pkg_svc->primary_svc
477 if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
478 $old_hidden = $old_pkg_svc->hidden;
481 next unless $old_quantity != $quantity ||
482 $old_primary_svc ne $primary_svc ||
483 $old_hidden ne $hidden;
485 my $new_pkg_svc = new FS::pkg_svc( {
486 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
487 'pkgpart' => $new->pkgpart,
488 'svcpart' => $part_svc->svcpart,
489 'quantity' => $quantity,
490 'primary_svc' => $primary_svc,
493 my $error = $old_pkg_svc
494 ? $new_pkg_svc->replace($old_pkg_svc)
495 : $new_pkg_svc->insert;
497 $dbh->rollback if $oldAutoCommit;
501 } #if $options->{pkg_svc}
503 my @part_pkg_vendor = $old->part_pkg_vendor;
504 my @current_exportnum = ();
505 if ( $options->{'part_pkg_vendor'} ) {
506 my($exportnum,$vendor_pkg_id);
507 while ( ($exportnum,$vendor_pkg_id)
508 = each %{$options->{'part_pkg_vendor'}} ) {
510 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
511 if($exportnum == $part_pkg_vendor->exportnum
512 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
513 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
514 my $error = $part_pkg_vendor->replace;
516 $dbh->rollback if $oldAutoCommit;
517 return "Error replacing part_pkg_vendor record: $error";
522 elsif($exportnum == $part_pkg_vendor->exportnum
523 && $vendor_pkg_id eq $part_pkg_vendor->vendor_pkg_id) {
528 unless ( $noinsert ) {
529 my $ppv = new FS::part_pkg_vendor( {
530 'pkgpart' => $new->pkgpart,
531 'exportnum' => $exportnum,
532 'vendor_pkg_id' => $vendor_pkg_id,
534 my $error = $ppv->insert;
536 $dbh->rollback if $oldAutoCommit;
537 return "Error inserting part_pkg_vendor record: $error";
540 push @current_exportnum, $exportnum;
543 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
544 unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
545 my $error = $part_pkg_vendor->delete;
547 $dbh->rollback if $oldAutoCommit;
548 return "Error deleting part_pkg_vendor record: $error";
553 # propagate changes to certain core fields
554 if ( $conf->exists('part_pkg-lineage') ) {
555 warn " propagating changes to family" if $DEBUG;
556 my $error = $new->propagate($old);
558 $dbh->rollback if $oldAutoCommit;
563 warn " committing transaction" if $DEBUG and $oldAutoCommit;
564 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
570 Checks all fields to make sure this is a valid package definition. If
571 there is an error, returns the error, otherwise returns false. Called by the
572 insert and replace methods.
578 warn "FS::part_pkg::check called on $self" if $DEBUG;
580 for (qw(setup recur plandata)) {
581 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
582 return "Use of $_ field is deprecated; set a plan and options: ".
584 if length($self->get($_));
588 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
589 my $error = $self->ut_number('freq');
590 return $error if $error;
592 $self->freq =~ /^(\d+[hdw]?)$/
593 or return "Illegal or empty freq: ". $self->freq;
597 my @null_agentnum_right = ( 'Edit global package definitions' );
598 push @null_agentnum_right, 'One-time charge'
599 if $self->freq =~ /^0/;
600 push @null_agentnum_right, 'Customize customer package'
601 if $self->disabled eq 'Y'; #good enough
603 my $error = $self->ut_numbern('pkgpart')
604 || $self->ut_text('pkg')
605 || $self->ut_text('comment')
606 || $self->ut_textn('promo_code')
607 || $self->ut_alphan('plan')
608 || $self->ut_enum('setuptax', [ '', 'Y' ] )
609 || $self->ut_enum('recurtax', [ '', 'Y' ] )
610 || $self->ut_textn('taxclass')
611 || $self->ut_enum('disabled', [ '', 'Y' ] )
612 || $self->ut_enum('custom', [ '', 'Y' ] )
613 || $self->ut_enum('no_auto', [ '', 'Y' ])
614 || $self->ut_enum('recur_show_zero', [ '', 'Y' ])
615 || $self->ut_enum('setup_show_zero', [ '', 'Y' ])
616 #|| $self->ut_moneyn('setup_cost')
617 #|| $self->ut_moneyn('recur_cost')
618 || $self->ut_floatn('setup_cost')
619 || $self->ut_floatn('recur_cost')
620 || $self->ut_floatn('pay_weight')
621 || $self->ut_floatn('credit_weight')
622 || $self->ut_numbern('taxproductnum')
623 || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
624 || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
625 || $self->ut_foreign_keyn('taxproductnum',
626 'part_pkg_taxproduct',
630 ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
631 : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
633 || $self->ut_numbern('fcc_ds0s')
634 || $self->ut_numbern('fcc_voip_class')
635 || $self->ut_numbern('delay_start')
636 || $self->ut_foreign_keyn('successor', 'part_pkg', 'pkgpart')
637 || $self->ut_foreign_keyn('family_pkgpart', 'part_pkg', 'pkgpart')
638 || $self->SUPER::check
640 return $error if $error;
642 return 'Unknown plan '. $self->plan
643 unless exists($plans{$self->plan});
645 my $conf = new FS::Conf;
646 return 'Taxclass is required'
647 if ! $self->taxclass && $conf->exists('require_taxclasses');
652 =item supersede OLD [, OPTION => VALUE ... ]
654 Inserts this package as a successor to the package OLD. All options are as
655 for C<insert>. After inserting, disables OLD and sets the new package as its
661 my ($new, $old, %options) = @_;
664 $new->set('pkgpart' => '');
665 $new->set('family_pkgpart' => $old->family_pkgpart);
666 warn " inserting successor package\n" if $DEBUG;
667 $error = $new->insert(%options);
668 return $error if $error;
670 warn " disabling superseded package\n" if $DEBUG;
671 $old->set('successor' => $new->pkgpart);
672 $old->set('disabled' => 'Y');
673 $error = $old->SUPER::replace; # don't change its options/pkg_svc records
674 return $error if $error;
676 warn " propagating changes to family" if $DEBUG;
677 $new->propagate($old);
682 If any of certain fields have changed from OLD to this package, then,
683 for all packages in the same lineage as this one, sets those fields
684 to their values in this package.
688 my @propagate_fields = (
689 qw( pkg classnum setup_cost recur_cost taxclass
690 setuptax recurtax pay_weight credit_weight
698 map { $_ => $new->get($_) }
699 grep { $new->get($_) ne $old->get($_) }
703 my @part_pkg = qsearch('part_pkg', {
704 'family_pkgpart' => $new->family_pkgpart
707 foreach my $part_pkg ( @part_pkg ) {
708 my $pkgpart = $part_pkg->pkgpart;
709 next if $pkgpart == $new->pkgpart; # don't modify $new
710 warn " propagating to pkgpart $pkgpart\n" if $DEBUG;
711 foreach ( keys %fields ) {
712 $part_pkg->set($_, $fields{$_});
714 # SUPER::replace to avoid changing non-core fields
715 my $error = $part_pkg->SUPER::replace;
716 push @error, "pkgpart $pkgpart: $error"
722 =item pkg_locale LOCALE
724 Returns a customer-viewable string representing this package for the given
725 locale, from the part_pkg_msgcat table. If the given locale is empty or no
726 localized string is found, returns the base pkg field.
731 my( $self, $locale ) = @_;
732 return $self->pkg unless $locale;
733 my $part_pkg_msgcat = $self->part_pkg_msgcat($locale) or return $self->pkg;
734 $part_pkg_msgcat->pkg;
737 =item part_pkg_msgcat LOCALE
739 Like pkg_locale, but returns the FS::part_pkg_msgcat object itself.
743 sub part_pkg_msgcat {
744 my( $self, $locale ) = @_;
745 qsearchs( 'part_pkg_msgcat', {
746 pkgpart => $self->pkgpart,
751 =item pkg_comment [ OPTION => VALUE... ]
753 Returns an (internal) string representing this package. Currently,
754 "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
755 future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
758 If the option nopkgpart is true then the "pkgpart: ' is omitted.
766 #$self->pkg. ' - '. $self->comment;
767 #$self->pkg. ' ('. $self->comment. ')';
768 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
769 $pre. $self->pkg. ' - '. $self->custom_comment;
772 sub price_info { # safety, in case a part_pkg hasn't defined price_info
778 ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment . ' ' . $self->price_info;
783 Returns the package class, as an FS::pkg_class object, or the empty string
784 if there is no package class.
790 if ( $self->classnum ) {
791 qsearchs('pkg_class', { 'classnum' => $self->classnum } );
797 =item addon_pkg_class
799 Returns the add-on package class, as an FS::pkg_class object, or the empty
800 string if there is no add-on package class.
804 sub addon_pkg_class {
806 if ( $self->addon_classnum ) {
807 qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
815 Returns the package category name, or the empty string if there is no package
822 my $pkg_class = $self->pkg_class;
824 ? $pkg_class->categoryname
830 Returns the package class name, or the empty string if there is no package
837 my $pkg_class = $self->pkg_class;
839 ? $pkg_class->classname
843 =item addon_classname
845 Returns the add-on package class name, or the empty string if there is no
846 add-on package class.
850 sub addon_classname {
852 my $pkg_class = $self->addon_pkg_class;
854 ? $pkg_class->classname
860 Returns the associated agent for this event, if any, as an FS::agent object.
866 qsearchs('agent', { 'agentnum' => $self->agentnum } );
869 =item pkg_svc [ HASHREF | OPTION => VALUE ]
871 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
872 definition (with non-zero quantity).
874 One option is available, I<disable_linked>. If set true it will return the
875 services for this package definition alone, omitting services from any add-on
882 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
889 qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
895 # #sort { $b->primary cmp $a->primary }
896 # grep { $_->quantity }
897 # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
899 my $opt = ref($_[0]) ? $_[0] : { @_ };
900 my %pkg_svc = map { $_->svcpart => $_ }
901 grep { $_->quantity }
902 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
904 unless ( $opt->{disable_linked} ) {
905 foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
906 my @pkg_svc = grep { $_->quantity }
907 qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
908 foreach my $pkg_svc ( @pkg_svc ) {
909 if ( $pkg_svc{$pkg_svc->svcpart} ) {
910 my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
911 $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
913 $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
923 =item svcpart [ SVCDB ]
925 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
926 associated with this package definition (see L<FS::pkg_svc>). Returns
927 false if there not a primary service definition or exactly one service
928 definition with quantity 1, or if SVCDB is specified and does not match the
929 svcdb of the service definition. SVCDB can be specified as a scalar table
930 name, such as 'svc_acct', or as an arrayref of possible table names.
935 my $pkg_svc = shift->_primary_pkg_svc(@_);
936 $pkg_svc ? $pkg_svc->svcpart : '';
939 =item part_svc [ SVCDB ]
941 Like the B<svcpart> method, but returns the FS::part_svc object (see
947 my $pkg_svc = shift->_primary_pkg_svc(@_);
948 $pkg_svc ? $pkg_svc->part_svc : '';
951 sub _primary_pkg_svc {
954 my $svcdb = scalar(@_) ? shift : [];
955 $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
956 my %svcdb = map { $_=>1 } @$svcdb;
959 grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
962 my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
963 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
965 return '' if scalar(@pkg_svc) != 1;
969 =item svcpart_unique_svcdb SVCDB
971 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
972 SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
973 false if there not a primary service definition for SVCDB or there are multiple
974 service definitions for SVCDB.
978 sub svcpart_unique_svcdb {
979 my( $self, $svcdb ) = @_;
980 my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
981 return '' if scalar(@svcdb_pkg_svc) != 1;
982 $svcdb_pkg_svc[0]->svcpart;
987 Returns a list of the acceptable payment types for this package. Eventually
988 this should come out of a database table and be editable, but currently has the
989 following logic instead:
991 If the package is free, the single item B<BILL> is
992 returned, otherwise, the single item B<CARD> is returned.
994 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
1000 if ( $self->is_free ) {
1009 Returns true if this package is free.
1015 if ( $self->can('is_free_options') ) {
1016 not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
1017 map { $self->option($_) }
1018 $self->is_free_options;
1020 warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
1021 "provides neither is_free_options nor is_free method; returning false";
1026 # whether the plan allows discounts to be applied to this package
1027 sub can_discount { 0; }
1029 # whether the plan allows changing the start date
1030 sub can_start_date { 1; }
1032 # the default start date; takes an FS::cust_main as an argument
1033 sub default_start_date {
1035 my $cust_main = shift;
1036 my $conf = FS::Conf->new;
1038 if ( $self->delay_start ) {
1039 my $delay = $self->delay_start;
1041 my ($mday,$mon,$year) = (localtime(time))[3,4,5];
1042 my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $delay;
1045 } elsif ( $conf->exists('order_pkg-no_start_date') ) {
1049 } elsif ( $cust_main ) {
1051 return $cust_main->next_bill_date;
1061 # moved to FS::Misc to make this accessible to other packages
1063 FS::Misc::pkg_freqs();
1068 Returns an english representation of the I<freq> field, such as "monthly",
1069 "weekly", "semi-annually", etc.
1075 my $freq = $self->freq;
1077 #my $freqs_href = $self->freqs_href;
1078 my $freqs_href = freqs_href();
1080 if ( exists($freqs_href->{$freq}) ) {
1081 $freqs_href->{$freq};
1083 my $interval = 'month';
1084 if ( $freq =~ /^(\d+)([hdw])$/ ) {
1085 my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
1086 $interval = $interval{$2};
1091 "every $freq ${interval}s";
1096 =item add_freq TIMESTAMP [ FREQ ]
1098 Adds a billing period of some frequency to the provided timestamp and
1099 returns the resulting timestamp, or -1 if the frequency could not be
1100 parsed (shouldn't happen). By default, the frequency of this package
1101 will be used; to override this, pass a different frequency as a second
1107 my( $self, $date, $freq ) = @_;
1108 $freq = $self->freq unless $freq;
1110 #change this bit to use Date::Manip? CAREFUL with timezones (see
1111 # mailing list archive)
1112 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
1114 if ( $freq =~ /^\d+$/ ) {
1116 until ( $mon < 12 ) { $mon -= 12; $year++; }
1118 $mday = 28 if $mday > 28 && FS::Conf->new->exists('anniversary-rollback');
1120 } elsif ( $freq =~ /^(\d+)w$/ ) {
1122 $mday += $weeks * 7;
1123 } elsif ( $freq =~ /^(\d+)d$/ ) {
1126 } elsif ( $freq =~ /^(\d+)h$/ ) {
1133 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
1138 For backwards compatibility, returns the plandata field as well as all options
1139 from FS::part_pkg_option.
1145 carp "plandata is deprecated";
1147 $self->SUPER::plandata(@_);
1149 my $plandata = $self->get('plandata');
1150 my %options = $self->options;
1151 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
1156 =item part_pkg_vendor
1158 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
1159 L<FS::part_pkg_vendor>).
1163 sub part_pkg_vendor {
1165 qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
1168 =item vendor_pkg_ids
1170 Returns a list of vendor/external package ids by exportnum
1174 sub vendor_pkg_ids {
1176 map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
1179 =item part_pkg_option
1181 Returns all options as FS::part_pkg_option objects (see
1182 L<FS::part_pkg_option>).
1186 sub part_pkg_option {
1188 qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
1193 Returns a list of option names and values suitable for assigning to a hash.
1199 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
1202 =item option OPTIONNAME [ QUIET ]
1204 Returns the option value for the given name, or the empty string. If a true
1205 value is passed as the second argument, warnings about missing the option
1211 my( $self, $opt, $ornull ) = @_;
1212 my $part_pkg_option =
1213 qsearchs('part_pkg_option', {
1214 pkgpart => $self->pkgpart,
1217 return $part_pkg_option->optionvalue if $part_pkg_option;
1218 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1219 split("\n", $self->get('plandata') );
1220 return $plandata{$opt} if exists $plandata{$opt};
1221 cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1222 "not found in options or plandata!\n"
1227 =item bill_part_pkg_link
1229 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1233 sub bill_part_pkg_link {
1234 shift->_part_pkg_link('bill', @_);
1237 =item svc_part_pkg_link
1239 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1243 sub svc_part_pkg_link {
1244 shift->_part_pkg_link('svc', @_);
1247 =item supp_part_pkg_link
1249 Returns the associated part_pkg_link records of type 'supp' (supplemental
1254 sub supp_part_pkg_link {
1255 shift->_part_pkg_link('supp', @_);
1258 sub _part_pkg_link {
1259 my( $self, $type ) = @_;
1260 qsearch({ table => 'part_pkg_link',
1261 hashref => { 'src_pkgpart' => $self->pkgpart,
1262 'link_type' => $type,
1263 #protection against infinite recursive links
1264 'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1266 order_by => "ORDER BY hidden",
1270 sub self_and_bill_linked {
1271 shift->_self_and_linked('bill', @_);
1274 sub self_and_svc_linked {
1275 shift->_self_and_linked('svc', @_);
1278 sub _self_and_linked {
1279 my( $self, $type, $hidden ) = @_;
1283 foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1284 $self->_part_pkg_link($type) ) )
1286 $_->hidden($hidden) if $hidden;
1293 =item part_pkg_taxoverride [ CLASS ]
1295 Returns all associated FS::part_pkg_taxoverride objects (see
1296 L<FS::part_pkg_taxoverride>). Limits the returned set to those
1297 of class CLASS if defined. Class may be one of 'setup', 'recur',
1298 the empty string (default), or a usage class number (see L<FS::usage_class>).
1299 When a class is specified, the empty string class (default) is returned
1300 if no more specific values exist.
1304 sub part_pkg_taxoverride {
1308 my $hashref = { 'pkgpart' => $self->pkgpart };
1309 $hashref->{'usage_class'} = $class if defined($class);
1310 my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1312 unless ( scalar(@overrides) || !defined($class) || !$class ){
1313 $hashref->{'usage_class'} = '';
1314 @overrides = qsearch('part_pkg_taxoverride', $hashref );
1320 =item has_taxproduct
1322 Returns true if this package has any taxproduct associated with it.
1326 sub has_taxproduct {
1329 $self->taxproductnum ||
1330 scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1331 keys %{ {$self->options} }
1337 =item taxproduct [ CLASS ]
1339 Returns the associated tax product for this package definition (see
1340 L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
1341 the usage classnum (see L<FS::usage_class>). Returns the default
1342 tax product for this record if the more specific CLASS value does
1351 my $part_pkg_taxproduct;
1353 my $taxproductnum = $self->taxproductnum;
1355 my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1356 $taxproductnum = $class_taxproductnum
1357 if $class_taxproductnum
1360 $part_pkg_taxproduct =
1361 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1363 unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1364 $taxproductnum = $self->taxproductnum;
1365 $part_pkg_taxproduct =
1366 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1369 $part_pkg_taxproduct;
1372 =item taxproduct_description [ CLASS ]
1374 Returns the description of the associated tax product for this package
1375 definition (see L<FS::part_pkg_taxproduct>).
1379 sub taxproduct_description {
1381 my $part_pkg_taxproduct = $self->taxproduct(@_);
1382 $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1385 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1387 Returns the package to taxrate m2m records for this package in the location
1388 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1389 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1390 (see L<FS::usage_class>).
1394 sub _expand_cch_taxproductnum {
1397 my $part_pkg_taxproduct = $self->taxproduct($class);
1399 my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1400 ? ( split ':', $part_pkg_taxproduct->taxproduct )
1403 $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1404 my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1405 OR taxproduct = '$a:$b:$c:'
1406 OR taxproduct = '$a:$b:".":$d'
1407 OR taxproduct = '$a:$b:".":' )";
1408 map { $_->taxproductnum } qsearch( { 'table' => 'part_pkg_taxproduct',
1409 'hashref' => { 'data_vendor'=>'cch' },
1410 'extra_sql' => $extra_sql,
1415 sub part_pkg_taxrate {
1417 my ($data_vendor, $geocode, $class) = @_;
1420 my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1421 dbh->quote($data_vendor);
1423 # CCH oddness in m2m
1424 $extra_sql .= ' AND ('.
1425 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1429 # much more CCH oddness in m2m -- this is kludgy
1430 my @tpnums = $self->_expand_cch_taxproductnum($class);
1431 if (scalar(@tpnums)) {
1432 $extra_sql .= ' AND ('.
1433 join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1436 $extra_sql .= ' AND ( 0 = 1 )';
1439 my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1440 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1441 my $select = 'DISTINCT ON(taxclassnum) *, taxproduct';
1443 # should qsearch preface columns with the table to facilitate joins?
1444 qsearch( { 'table' => 'part_pkg_taxrate',
1445 'select' => $select,
1446 'hashref' => { # 'data_vendor' => $data_vendor,
1447 # 'taxproductnum' => $self->taxproductnum,
1449 'addl_from' => $addl_from,
1450 'extra_sql' => $extra_sql,
1451 'order_by' => $order_by,
1455 =item part_pkg_discount
1457 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1462 sub part_pkg_discount {
1464 qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1467 =item part_pkg_usage
1469 Returns the voice usage pools (see L<FS::part_pkg_usage>) defined for
1474 sub part_pkg_usage {
1476 qsearch('part_pkg_usage', { 'pkgpart' => $self->pkgpart });
1481 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1482 PLAN is the object's I<plan> field. There should be better docs
1483 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1489 my $plan = $self->plan;
1491 cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1495 return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1496 my $class = ref($self). "::$plan";
1497 warn "reblessing $self into $class" if $DEBUG > 1;
1500 bless($self, $class) unless $@;
1505 sub calc_setup { die 'no calc_setup for '. shift->plan. "\n"; }
1506 sub calc_recur { die 'no calc_recur for '. shift->plan. "\n"; }
1508 #fallback that return 0 for old legacy packages with no plan
1509 sub calc_remain { 0; }
1510 sub calc_units { 0; }
1512 #fallback for everything not based on flat.pm
1513 sub recur_temporality { 'upcoming'; }
1514 sub calc_cancel { 0; }
1516 #fallback for everything except bulk.pm
1517 sub hide_svc_detail { 0; }
1519 #fallback for packages that can't/won't summarize usage
1520 sub sum_usage { 0; }
1522 =item recur_cost_permonth CUST_PKG
1524 recur_cost divided by freq (only supported for monthly and longer frequencies)
1528 sub recur_cost_permonth {
1529 my($self, $cust_pkg) = @_;
1530 return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1531 sprintf('%.2f', $self->recur_cost / $self->freq );
1534 =item cust_bill_pkg_recur CUST_PKG
1536 Actual recurring charge for the specified customer package from customer's most
1541 sub cust_bill_pkg_recur {
1542 my($self, $cust_pkg) = @_;
1543 my $cust_bill_pkg = qsearchs({
1544 'table' => 'cust_bill_pkg',
1545 'addl_from' => 'LEFT JOIN cust_bill USING ( invnum )',
1546 'hashref' => { 'pkgnum' => $cust_pkg->pkgnum,
1547 'recur' => { op=>'>', value=>'0' },
1549 'order_by' => 'ORDER BY cust_bill._date DESC,
1550 cust_bill_pkg.sdate DESC
1553 }) or return 0; #die "use cust_bill_pkg_recur credits with once_perinv condition";
1554 $cust_bill_pkg->recur;
1557 =item format OPTION DATA
1559 Returns data formatted according to the function 'format' described
1560 in the plan info. Returns DATA if no such function exists.
1565 my ($self, $option, $data) = (shift, shift, shift);
1566 if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1567 &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1573 =item parse OPTION DATA
1575 Returns data parsed according to the function 'parse' described
1576 in the plan info. Returns DATA if no such function exists.
1581 my ($self, $option, $data) = (shift, shift, shift);
1582 if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1583 &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1593 =head1 CLASS METHODS
1601 # Used by FS::Upgrade to migrate to a new database.
1603 sub _upgrade_data { # class method
1604 my($class, %opts) = @_;
1606 warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1608 my @part_pkg = qsearch({
1609 'table' => 'part_pkg',
1610 'extra_sql' => "WHERE ". join(' OR ',
1611 'plan IS NULL', "plan = '' ",
1615 foreach my $part_pkg (@part_pkg) {
1617 unless ( $part_pkg->plan ) {
1618 $part_pkg->plan('flat');
1625 # now upgrade to the explicit custom flag
1627 @part_pkg = qsearch({
1628 'table' => 'part_pkg',
1629 'hashref' => { disabled => 'Y', custom => '' },
1630 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1633 foreach my $part_pkg (@part_pkg) {
1634 my $new = new FS::part_pkg { $part_pkg->hash };
1636 my $comment = $part_pkg->comment;
1637 $comment =~ s/^\(CUSTOM\) //;
1638 $comment = '(none)' unless $comment =~ /\S/;
1639 $new->comment($comment);
1641 my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1642 my $primary = $part_pkg->svcpart;
1643 my $options = { $part_pkg->options };
1645 my $error = $new->replace( $part_pkg,
1646 'pkg_svc' => $pkg_svc,
1647 'primary_svc' => $primary,
1648 'options' => $options,
1650 die $error if $error;
1653 # set family_pkgpart on any packages that don't have it
1654 @part_pkg = qsearch('part_pkg', { 'family_pkgpart' => '' });
1655 foreach my $part_pkg (@part_pkg) {
1656 $part_pkg->set('family_pkgpart' => $part_pkg->pkgpart);
1657 my $error = $part_pkg->SUPER::replace;
1658 die $error if $error;
1661 my @part_pkg_option = qsearch('part_pkg_option',
1662 { 'optionname' => 'unused_credit',
1665 foreach my $old_opt (@part_pkg_option) {
1666 my $pkgpart = $old_opt->pkgpart;
1667 my $error = $old_opt->delete;
1668 die $error if $error;
1670 foreach (qw(unused_credit_cancel unused_credit_change)) {
1671 my $new_opt = new FS::part_pkg_option {
1672 'pkgpart' => $pkgpart,
1676 $error = $new_opt->insert;
1677 die $error if $error;
1681 # migrate use_disposition_taqua and use_disposition to disposition_in
1682 @part_pkg_option = qsearch('part_pkg_option',
1683 { 'optionname' => { op => 'LIKE',
1684 value => 'use_disposition%',
1688 my %newopts = map { $_->pkgpart => $_ }
1689 qsearch('part_pkg_option', { 'optionname' => 'disposition_in', } );
1690 foreach my $old_opt (@part_pkg_option) {
1691 my $pkgpart = $old_opt->pkgpart;
1692 my $newval = $old_opt->optionname eq 'use_disposition_taqua' ? '100'
1694 my $error = $old_opt->delete;
1695 die $error if $error;
1697 if ( exists($newopts{$pkgpart}) ) {
1698 my $opt = $newopts{$pkgpart};
1699 $opt->optionvalue($opt->optionvalue.",$newval");
1700 $error = $opt->replace;
1701 die $error if $error;
1703 my $new_opt = new FS::part_pkg_option {
1704 'pkgpart' => $pkgpart,
1705 'optionname' => 'disposition_in',
1706 'optionvalue' => $newval,
1708 $error = $new_opt->insert;
1709 die $error if $error;
1710 $newopts{$pkgpart} = $new_opt;
1714 # set any package with FCC voice lines to the "VoIP with broadband" category
1715 # for backward compatibility
1717 # recover from a bad upgrade bug
1718 my $upgrade = 'part_pkg_fcc_voip_class_FIX';
1719 if (!FS::upgrade_journal->is_done($upgrade)) {
1720 my $bad_upgrade = qsearchs('upgrade_journal',
1721 { upgrade => 'part_pkg_fcc_voip_class' }
1723 if ( $bad_upgrade ) {
1724 my $where = 'WHERE history_date <= '.$bad_upgrade->_date.
1725 ' AND history_date > '.($bad_upgrade->_date - 3600);
1726 my @h_part_pkg_option = map { FS::part_pkg_option->new($_->hashref) }
1729 'table' => 'h_part_pkg_option',
1731 'extra_sql' => "$where AND history_action = 'delete'",
1732 'order_by' => 'ORDER BY history_date ASC',
1734 my @h_pkg_svc = map { FS::pkg_svc->new($_->hashref) }
1737 'table' => 'h_pkg_svc',
1739 'extra_sql' => "$where AND history_action = 'replace_old'",
1740 'order_by' => 'ORDER BY history_date ASC',
1743 foreach my $deleted (@h_part_pkg_option, @h_pkg_svc) {
1744 my $pkgpart ||= $deleted->pkgpart;
1745 $opt{$pkgpart} ||= {
1751 if ( $deleted->isa('FS::part_pkg_option') ) {
1752 $opt{$pkgpart}{options}{ $deleted->optionname } = $deleted->optionvalue;
1754 my $svcpart = $deleted->svcpart;
1755 $opt{$pkgpart}{pkg_svc}{$svcpart} = $deleted->quantity;
1756 $opt{$pkgpart}{hidden_svc}{$svcpart} ||= $deleted->hidden;
1757 $opt{$pkgpart}{primary_svc} = $svcpart if $deleted->primary_svc;
1760 foreach my $pkgpart (keys %opt) {
1761 my $part_pkg = FS::part_pkg->by_key($pkgpart);
1762 my $error = $part_pkg->replace( $part_pkg->replace_old, $opt{$pkgpart} );
1764 die "error recovering damaged pkgpart $pkgpart:\n$error\n";
1767 } # $bad_upgrade exists
1768 else { # do the original upgrade, but correctly this time
1769 @part_pkg = qsearch('part_pkg', {
1770 fcc_ds0s => { op => '>', value => 0 },
1771 fcc_voip_class => ''
1773 foreach my $part_pkg (@part_pkg) {
1774 $part_pkg->set(fcc_voip_class => 2);
1775 my @pkg_svc = $part_pkg->pkg_svc;
1776 my %quantity = map {$_->svcpart, $_->quantity} @pkg_svc;
1777 my %hidden = map {$_->svcpart, $_->hidden } @pkg_svc;
1778 my $error = $part_pkg->replace(
1779 $part_pkg->replace_old,
1780 options => { $part_pkg->options },
1781 pkg_svc => \%quantity,
1782 hidden_svc => \%hidden,
1783 primary_svc => ($part_pkg->svcpart || ''),
1785 die $error if $error;
1788 FS::upgrade_journal->set_done($upgrade);
1793 =item curuser_pkgs_sql
1795 Returns an SQL fragment for searching for packages the current user can
1796 use, either via part_pkg.agentnum directly, or via agent type (see
1801 sub curuser_pkgs_sql {
1804 $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1808 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1810 Returns an SQL fragment for searching for packages the provided agent or agents
1811 can use, either via part_pkg.agentnum directly, or via agent type (see
1816 sub agent_pkgs_sql {
1817 my $class = shift; #i'm a class method, not a sub (the question is... why??)
1818 my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1820 $class->_pkgs_sql(@agentnums); #is this why
1825 my( $class, @agentnums ) = @_;
1826 my $agentnums = join(',', @agentnums);
1830 ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
1831 OR ( agentnum IS NULL
1832 AND EXISTS ( SELECT 1
1834 LEFT JOIN agent_type USING ( typenum )
1835 LEFT JOIN agent AS typeagent USING ( typenum )
1836 WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1837 AND typeagent.agentnum IN ($agentnums)
1855 #false laziness w/part_export & cdr
1857 foreach my $INC ( @INC ) {
1858 warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1859 foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1860 warn "attempting to load plan info from $file\n" if $DEBUG;
1861 $file =~ /\/(\w+)\.pm$/ or do {
1862 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1866 my $info = eval "use FS::part_pkg::$mod; ".
1867 "\\%FS::part_pkg::$mod\::info;";
1869 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1872 unless ( keys %$info ) {
1873 warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1876 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1877 #if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1878 # warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1881 $info{$mod} = $info;
1882 $info->{'weight'} ||= 0; # quiet warnings
1886 # copy one level deep to allow replacement of fields and fieldorder
1887 tie %plans, 'Tie::IxHash',
1888 map { my %infohash = %{ $info{$_} };
1890 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1893 # inheritance of plan options
1894 foreach my $name (keys(%info)) {
1895 if (exists($info{$name}->{'disabled'}) and $info{$name}->{'disabled'}) {
1896 warn "skipping disabled plan FS::part_pkg::$name" if $DEBUG;
1897 delete $plans{$name};
1900 my $parents = $info{$name}->{'inherit_fields'} || [];
1901 my (%fields, %field_exists, @fieldorder);
1902 foreach my $parent ($name, @$parents) {
1903 if ( !exists($info{$parent}) ) {
1904 warn "$name tried to inherit from nonexistent '$parent'\n";
1907 %fields = ( # avoid replacing existing fields
1908 %{ $info{$parent}->{'fields'} || {} },
1911 foreach (@{ $info{$parent}->{'fieldorder'} || [] }) {
1913 next if $field_exists{$_};
1914 $field_exists{$_} = 1;
1915 # allow inheritors to remove inherited fields from the fieldorder
1916 push @fieldorder, $_ if !exists($fields{$_}) or
1917 !exists($fields{$_}->{'disabled'});
1920 $plans{$name}->{'fields'} = \%fields;
1921 $plans{$name}->{'fieldorder'} = \@fieldorder;
1931 =head1 NEW PLAN CLASSES
1933 A module should be added in FS/FS/part_pkg/ Eventually, an example may be
1934 found in eg/plan_template.pm. Until then, it is suggested that you use the
1935 other modules in FS/FS/part_pkg/ as a guide.
1939 The delete method is unimplemented.
1941 setup and recur semantics are not yet defined (and are implemented in
1942 FS::cust_bill. hmm.). now they're deprecated and need to go.
1946 part_pkg_taxrate is Pg specific
1948 replace should be smarter about managing the related tables (options, pkg_svc)
1952 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1953 schema.html from the base documentation.