4 use vars qw( @ISA %plans $DEBUG $setup_hack $skip_pkg_svc_hack );
5 use Carp qw(carp cluck confess);
6 use Scalar::Util qw( blessed );
7 use Time::Local qw( timelocal_nocheck );
10 use FS::Record qw( qsearch qsearchs dbh dbdef );
16 use FS::part_pkg_option;
19 use FS::part_pkg_taxrate;
20 use FS::part_pkg_taxoverride;
21 use FS::part_pkg_taxproduct;
22 use FS::part_pkg_link;
23 use FS::part_pkg_discount;
25 @ISA = qw( FS::m2m_Common FS::option_Common );
28 $skip_pkg_svc_hack = 0;
32 FS::part_pkg - Object methods for part_pkg objects
38 $record = new FS::part_pkg \%hash
39 $record = new FS::part_pkg { 'column' => 'value' };
41 $custom_record = $template_record->clone;
43 $error = $record->insert;
45 $error = $new_record->replace($old_record);
47 $error = $record->delete;
49 $error = $record->check;
51 @pkg_svc = $record->pkg_svc;
53 $svcnum = $record->svcpart;
54 $svcnum = $record->svcpart( 'svc_acct' );
58 An FS::part_pkg object represents a package definition. FS::part_pkg
59 inherits from FS::Record. The following fields are currently supported:
63 =item pkgpart - primary key (assigned automatically for new package definitions)
65 =item pkg - Text name of this package definition (customer-viewable)
67 =item comment - Text name of this package definition (non-customer-viewable)
69 =item classnum - Optional package class (see L<FS::pkg_class>)
71 =item promo_code - Promotional code
73 =item setup - Setup fee expression (deprecated)
75 =item freq - Frequency of recurring fee
77 =item recur - Recurring fee expression (deprecated)
79 =item setuptax - Setup fee tax exempt flag, empty or `Y'
81 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
83 =item taxclass - Tax class
85 =item plan - Price plan
87 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
89 =item disabled - Disabled flag, empty or `Y'
91 =item custom - Custom flag, empty or `Y'
93 =item setup_cost - for cost tracking
95 =item recur_cost - for cost tracking
97 =item pay_weight - Weight (relative to credit_weight and other package definitions) that controls payment application to specific line items.
99 =item credit_weight - Weight (relative to other package definitions) that controls credit application to specific line items.
101 =item agentnum - Optional agentnum (see L<FS::agent>)
103 =item fcc_ds0s - Optional DS0 equivalency number for FCC form 477
113 Creates a new package definition. To add the package definition to
114 the database, see L<"insert">.
118 sub table { 'part_pkg'; }
122 An alternate constructor. Creates a new package definition by duplicating
123 an existing definition. A new pkgpart is assigned and the custom flag is
124 set to Y. To add the package definition to the database, see L<"insert">.
130 my $class = ref($self);
131 my %hash = $self->hash;
132 $hash{'pkgpart'} = '';
133 $hash{'custom'} = 'Y';
134 #new FS::part_pkg ( \%hash ); # ?
135 new $class ( \%hash ); # ?
138 =item insert [ , OPTION => VALUE ... ]
140 Adds this package definition to the database. If there is an error,
141 returns the error, otherwise returns false.
143 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg>,
144 I<custnum_ref> and I<options>.
146 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
147 values, appropriate FS::pkg_svc records will be inserted. I<hidden_svc> can
148 be set to a hashref of svcparts and flag values ('Y' or '') to set the
149 'hidden' field in these records.
151 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
152 FS::pkg_svc record will be updated.
154 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
155 record itself), the object will be updated to point to this package definition.
157 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
158 the scalar will be updated with the custnum value from the cust_pkg record.
160 If I<tax_overrides> is set to a hashref with usage classes as keys and comma
161 separated tax class numbers as values, appropriate FS::part_pkg_taxoverride
162 records will be inserted.
164 If I<options> is set to a hashref of options, appropriate FS::part_pkg_option
165 records will be inserted.
172 warn "FS::part_pkg::insert called on $self with options ".
173 join(', ', map "$_=>$options{$_}", keys %options)
176 local $SIG{HUP} = 'IGNORE';
177 local $SIG{INT} = 'IGNORE';
178 local $SIG{QUIT} = 'IGNORE';
179 local $SIG{TERM} = 'IGNORE';
180 local $SIG{TSTP} = 'IGNORE';
181 local $SIG{PIPE} = 'IGNORE';
183 my $oldAutoCommit = $FS::UID::AutoCommit;
184 local $FS::UID::AutoCommit = 0;
187 warn " inserting part_pkg record" if $DEBUG;
188 my $error = $self->SUPER::insert( $options{options} );
190 $dbh->rollback if $oldAutoCommit;
194 my $conf = new FS::Conf;
195 if ( $conf->exists('agent_defaultpkg') ) {
196 warn " agent_defaultpkg set; allowing all agents to purchase package"
198 foreach my $agent_type ( qsearch('agent_type', {} ) ) {
199 my $type_pkgs = new FS::type_pkgs({
200 'typenum' => $agent_type->typenum,
201 'pkgpart' => $self->pkgpart,
203 my $error = $type_pkgs->insert;
205 $dbh->rollback if $oldAutoCommit;
211 warn " inserting part_pkg_taxoverride records" if $DEBUG;
212 my %overrides = %{ $options{'tax_overrides'} || {} };
213 foreach my $usage_class ( keys %overrides ) {
215 ( exists($overrides{$usage_class}) && defined($overrides{$usage_class}) )
216 ? $overrides{$usage_class}
218 my @overrides = (grep "$_", split(',', $override) );
219 my $error = $self->process_m2m (
220 'link_table' => 'part_pkg_taxoverride',
221 'target_table' => 'tax_class',
222 'hashref' => { 'usage_class' => $usage_class },
223 'params' => \@overrides,
226 $dbh->rollback if $oldAutoCommit;
231 unless ( $skip_pkg_svc_hack ) {
233 warn " inserting pkg_svc records" if $DEBUG;
234 my $pkg_svc = $options{'pkg_svc'} || {};
235 my $hidden_svc = $options{'hidden_svc'} || {};
236 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
237 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
239 ( $options{'primary_svc'} && $options{'primary_svc'}==$part_svc->svcpart )
243 my $pkg_svc = new FS::pkg_svc( {
244 'pkgpart' => $self->pkgpart,
245 'svcpart' => $part_svc->svcpart,
246 'quantity' => $quantity,
247 'primary_svc' => $primary_svc,
248 'hidden' => $hidden_svc->{$part_svc->svcpart},
250 my $error = $pkg_svc->insert;
252 $dbh->rollback if $oldAutoCommit;
259 if ( $options{'cust_pkg'} ) {
260 warn " updating cust_pkg record " if $DEBUG;
262 ref($options{'cust_pkg'})
263 ? $options{'cust_pkg'}
264 : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
265 ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
266 if $options{'custnum_ref'};
267 my %hash = $old_cust_pkg->hash;
268 $hash{'pkgpart'} = $self->pkgpart,
269 my $new_cust_pkg = new FS::cust_pkg \%hash;
270 local($FS::cust_pkg::disable_agentcheck) = 1;
271 my $error = $new_cust_pkg->replace($old_cust_pkg);
273 $dbh->rollback if $oldAutoCommit;
274 return "Error modifying cust_pkg record: $error";
278 if ( $options{'part_pkg_vendor'} ) {
279 my($exportnum,$vendor_pkg_id);
280 my %options_part_pkg_vendor = $options{'part_pkg_vendor'};
281 while(($exportnum,$vendor_pkg_id) = each %options_part_pkg_vendor){
282 my $ppv = new FS::part_pkg_vendor( {
283 'pkgpart' => $self->pkgpart,
284 'exportnum' => $exportnum,
285 'vendor_pkg_id' => $vendor_pkg_id,
287 my $error = $ppv->insert;
289 $dbh->rollback if $oldAutoCommit;
290 return "Error inserting part_pkg_vendor record: $error";
295 warn " commiting transaction" if $DEBUG;
296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
303 Currently unimplemented.
308 return "Can't (yet?) delete package definitions.";
309 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
312 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
314 Replaces OLD_RECORD with this one in the database. If there is an error,
315 returns the error, otherwise returns false.
317 Currently available options are: I<pkg_svc>, I<hidden_svc>, I<primary_svc>
320 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
321 values, the appropriate FS::pkg_svc records will be replaced. I<hidden_svc>
322 can be set to a hashref of svcparts and flag values ('Y' or '') to set the
323 'hidden' field in these records.
325 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
326 FS::pkg_svc record will be updated.
328 If I<options> is set to a hashref, the appropriate FS::part_pkg_option records
336 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
341 ( ref($_[0]) eq 'HASH' )
345 $options->{options} = {} unless defined($options->{options});
347 warn "FS::part_pkg::replace called on $new to replace $old with options".
348 join(', ', map "$_ => ". $options->{$_}, keys %$options)
351 local $SIG{HUP} = 'IGNORE';
352 local $SIG{INT} = 'IGNORE';
353 local $SIG{QUIT} = 'IGNORE';
354 local $SIG{TERM} = 'IGNORE';
355 local $SIG{TSTP} = 'IGNORE';
356 local $SIG{PIPE} = 'IGNORE';
358 my $oldAutoCommit = $FS::UID::AutoCommit;
359 local $FS::UID::AutoCommit = 0;
362 #plandata shit stays in replace for upgrades until after 2.0 (or edit
364 warn " saving legacy plandata" if $DEBUG;
365 my $plandata = $new->get('plandata');
366 $new->set('plandata', '');
368 warn " deleting old part_pkg_option records" if $DEBUG;
369 foreach my $part_pkg_option ( $old->part_pkg_option ) {
370 my $error = $part_pkg_option->delete;
372 $dbh->rollback if $oldAutoCommit;
377 warn " replacing part_pkg record" if $DEBUG;
378 my $error = $new->SUPER::replace($old, $options->{options} );
380 $dbh->rollback if $oldAutoCommit;
384 warn " inserting part_pkg_option records for plandata: $plandata|" if $DEBUG;
385 foreach my $part_pkg_option (
386 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
387 return "illegal plandata: $plandata";
389 new FS::part_pkg_option {
390 'pkgpart' => $new->pkgpart,
395 split("\n", $plandata)
397 my $error = $part_pkg_option->insert;
399 $dbh->rollback if $oldAutoCommit;
404 warn " replacing pkg_svc records" if $DEBUG;
405 my $pkg_svc = $options->{'pkg_svc'} || {};
406 my $hidden_svc = $options->{'hidden_svc'} || {};
407 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
408 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
409 my $hidden = $hidden_svc->{$part_svc->svcpart} || '';
411 ( defined($options->{'primary_svc'}) && $options->{'primary_svc'}
412 && $options->{'primary_svc'} == $part_svc->svcpart
417 my $old_pkg_svc = qsearchs('pkg_svc', {
418 'pkgpart' => $old->pkgpart,
419 'svcpart' => $part_svc->svcpart,
422 my $old_quantity = 0;
423 my $old_primary_svc = '';
425 if ( $old_pkg_svc ) {
426 $old_quantity = $old_pkg_svc->quantity;
427 $old_primary_svc = $old_pkg_svc->primary_svc
428 if $old_pkg_svc->dbdef_table->column('primary_svc'); # is this needed?
429 $old_hidden = $old_pkg_svc->hidden;
432 next unless $old_quantity != $quantity ||
433 $old_primary_svc ne $primary_svc ||
434 $old_hidden ne $hidden;
436 my $new_pkg_svc = new FS::pkg_svc( {
437 'pkgsvcnum' => ( $old_pkg_svc ? $old_pkg_svc->pkgsvcnum : '' ),
438 'pkgpart' => $new->pkgpart,
439 'svcpart' => $part_svc->svcpart,
440 'quantity' => $quantity,
441 'primary_svc' => $primary_svc,
444 my $error = $old_pkg_svc
445 ? $new_pkg_svc->replace($old_pkg_svc)
446 : $new_pkg_svc->insert;
448 $dbh->rollback if $oldAutoCommit;
453 my @part_pkg_vendor = $old->part_pkg_vendor;
454 my @current_exportnum = ();
455 if ( $options->{'part_pkg_vendor'} ) {
456 my($exportnum,$vendor_pkg_id);
457 while ( ($exportnum,$vendor_pkg_id)
458 = each %{$options->{'part_pkg_vendor'}} ) {
460 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
461 if($exportnum == $part_pkg_vendor->exportnum
462 && $vendor_pkg_id ne $part_pkg_vendor->vendor_pkg_id) {
463 $part_pkg_vendor->vendor_pkg_id($vendor_pkg_id);
464 my $error = $part_pkg_vendor->replace;
466 $dbh->rollback if $oldAutoCommit;
467 return "Error replacing part_pkg_vendor record: $error";
473 unless ( $replaced ) {
474 my $ppv = new FS::part_pkg_vendor( {
475 'pkgpart' => $new->pkgpart,
476 'exportnum' => $exportnum,
477 'vendor_pkg_id' => $vendor_pkg_id,
479 my $error = $ppv->insert;
481 $dbh->rollback if $oldAutoCommit;
482 return "Error inserting part_pkg_vendor record: $error";
485 push @current_exportnum, $exportnum;
488 foreach my $part_pkg_vendor ( @part_pkg_vendor ) {
489 unless ( grep($_ eq $part_pkg_vendor->exportnum, @current_exportnum) ) {
490 my $error = $part_pkg_vendor->delete;
492 $dbh->rollback if $oldAutoCommit;
493 return "Error deleting part_pkg_vendor record: $error";
498 warn " commiting transaction" if $DEBUG;
499 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
505 Checks all fields to make sure this is a valid package definition. If
506 there is an error, returns the error, otherwise returns false. Called by the
507 insert and replace methods.
513 warn "FS::part_pkg::check called on $self" if $DEBUG;
515 for (qw(setup recur plandata)) {
516 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
517 return "Use of $_ field is deprecated; set a plan and options: ".
519 if length($self->get($_));
523 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
524 my $error = $self->ut_number('freq');
525 return $error if $error;
527 $self->freq =~ /^(\d+[hdw]?)$/
528 or return "Illegal or empty freq: ". $self->freq;
532 my @null_agentnum_right = ( 'Edit global package definitions' );
533 push @null_agentnum_right, 'One-time charge'
534 if $self->freq =~ /^0/;
535 push @null_agentnum_right, 'Customize customer package'
536 if $self->disabled eq 'Y'; #good enough
538 my $error = $self->ut_numbern('pkgpart')
539 || $self->ut_text('pkg')
540 || $self->ut_text('comment')
541 || $self->ut_textn('promo_code')
542 || $self->ut_alphan('plan')
543 || $self->ut_enum('setuptax', [ '', 'Y' ] )
544 || $self->ut_enum('recurtax', [ '', 'Y' ] )
545 || $self->ut_textn('taxclass')
546 || $self->ut_enum('disabled', [ '', 'Y' ] )
547 || $self->ut_enum('custom', [ '', 'Y' ] )
548 || $self->ut_enum('no_auto', [ '', 'Y' ])
549 #|| $self->ut_moneyn('setup_cost')
550 #|| $self->ut_moneyn('recur_cost')
551 || $self->ut_floatn('setup_cost')
552 || $self->ut_floatn('recur_cost')
553 || $self->ut_floatn('pay_weight')
554 || $self->ut_floatn('credit_weight')
555 || $self->ut_numbern('taxproductnum')
556 || $self->ut_foreign_keyn('classnum', 'pkg_class', 'classnum')
557 || $self->ut_foreign_keyn('addon_classnum', 'pkg_class', 'classnum')
558 || $self->ut_foreign_keyn('taxproductnum',
559 'part_pkg_taxproduct',
563 ? $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum' )
564 : $self->ut_agentnum_acl('agentnum', \@null_agentnum_right)
566 || $self->ut_numbern('fcc_ds0s')
567 || $self->SUPER::check
569 return $error if $error;
571 return 'Unknown plan '. $self->plan
572 unless exists($plans{$self->plan});
574 my $conf = new FS::Conf;
575 return 'Taxclass is required'
576 if ! $self->taxclass && $conf->exists('require_taxclasses');
581 =item pkg_comment [ OPTION => VALUE... ]
583 Returns an (internal) string representing this package. Currently,
584 "pkgpart: pkg - comment", is returned. "pkg - comment" may be returned in the
585 future, omitting pkgpart. The comment will have '(CUSTOM) ' prepended if
588 If the option nopkgpart is true then the "pkgpart: ' is omitted.
596 #$self->pkg. ' - '. $self->comment;
597 #$self->pkg. ' ('. $self->comment. ')';
598 my $pre = $opt{nopkgpart} ? '' : $self->pkgpart. ': ';
599 $pre. $self->pkg. ' - '. $self->custom_comment;
604 ( $self->custom ? '(CUSTOM) ' : '' ). $self->comment;
609 Returns the package class, as an FS::pkg_class object, or the empty string
610 if there is no package class.
616 if ( $self->classnum ) {
617 qsearchs('pkg_class', { 'classnum' => $self->classnum } );
623 =item addon_pkg_class
625 Returns the add-on package class, as an FS::pkg_class object, or the empty
626 string if there is no add-on package class.
630 sub addon_pkg_class {
632 if ( $self->addon_classnum ) {
633 qsearchs('pkg_class', { 'classnum' => $self->addon_classnum } );
641 Returns the package category name, or the empty string if there is no package
648 my $pkg_class = $self->pkg_class;
650 ? $pkg_class->categoryname
656 Returns the package class name, or the empty string if there is no package
663 my $pkg_class = $self->pkg_class;
665 ? $pkg_class->classname
669 =item addon_classname
671 Returns the add-on package class name, or the empty string if there is no
672 add-on package class.
676 sub addon_classname {
678 my $pkg_class = $self->addon_pkg_class;
680 ? $pkg_class->classname
686 Returns the associated agent for this event, if any, as an FS::agent object.
692 qsearchs('agent', { 'agentnum' => $self->agentnum } );
695 =item pkg_svc [ HASHREF | OPTION => VALUE ]
697 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
698 definition (with non-zero quantity).
700 One option is available, I<disable_linked>. If set true it will return the
701 services for this package definition alone, omitting services from any add-on
708 Returns all FS::type_pkgs objects (see L<FS::type_pkgs>) for this package
715 qsearch('type_pkgs', { 'pkgpart' => $self->pkgpart } );
721 # #sort { $b->primary cmp $a->primary }
722 # grep { $_->quantity }
723 # qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
725 my $opt = ref($_[0]) ? $_[0] : { @_ };
726 my %pkg_svc = map { $_->svcpart => $_ }
727 grep { $_->quantity }
728 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
730 unless ( $opt->{disable_linked} ) {
731 foreach my $dst_pkg ( map $_->dst_pkg, $self->svc_part_pkg_link ) {
732 my @pkg_svc = grep { $_->quantity }
733 qsearch( 'pkg_svc', { pkgpart=>$dst_pkg->pkgpart } );
734 foreach my $pkg_svc ( @pkg_svc ) {
735 if ( $pkg_svc{$pkg_svc->svcpart} ) {
736 my $quantity = $pkg_svc{$pkg_svc->svcpart}->quantity;
737 $pkg_svc{$pkg_svc->svcpart}->quantity($quantity + $pkg_svc->quantity);
739 $pkg_svc{$pkg_svc->svcpart} = $pkg_svc;
749 =item svcpart [ SVCDB ]
751 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
752 associated with this package definition (see L<FS::pkg_svc>). Returns
753 false if there not a primary service definition or exactly one service
754 definition with quantity 1, or if SVCDB is specified and does not match the
755 svcdb of the service definition. SVCDB can be specified as a scalar table
756 name, such as 'svc_acct', or as an arrayref of possible table names.
761 my $pkg_svc = shift->_primary_pkg_svc(@_);
762 $pkg_svc ? $pkg_svc->svcpart : '';
765 =item part_svc [ SVCDB ]
767 Like the B<svcpart> method, but returns the FS::part_svc object (see
773 my $pkg_svc = shift->_primary_pkg_svc(@_);
774 $pkg_svc ? $pkg_svc->part_svc : '';
777 sub _primary_pkg_svc {
780 my $svcdb = scalar(@_) ? shift : [];
781 $svcdb = ref($svcdb) ? $svcdb : [ $svcdb ];
782 my %svcdb = map { $_=>1 } @$svcdb;
785 grep { !scalar(@$svcdb) || $svcdb{ $_->part_svc->svcdb } }
788 my @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc;
789 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
791 return '' if scalar(@pkg_svc) != 1;
795 =item svcpart_unique_svcdb SVCDB
797 Returns the svcpart of a service definition (see L<FS::part_svc>) matching
798 SVCDB associated with this package definition (see L<FS::pkg_svc>). Returns
799 false if there not a primary service definition for SVCDB or there are multiple
800 service definitions for SVCDB.
804 sub svcpart_unique_svcdb {
805 my( $self, $svcdb ) = @_;
806 my @svcdb_pkg_svc = grep { ( $svcdb eq $_->part_svc->svcdb ) } $self->pkg_svc;
807 return '' if scalar(@svcdb_pkg_svc) != 1;
808 $svcdb_pkg_svc[0]->svcpart;
813 Returns a list of the acceptable payment types for this package. Eventually
814 this should come out of a database table and be editable, but currently has the
815 following logic instead:
817 If the package is free, the single item B<BILL> is
818 returned, otherwise, the single item B<CARD> is returned.
820 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
826 if ( $self->is_free ) {
835 Returns true if this package is free.
841 unless ( $self->plan ) {
842 $self->setup =~ /^\s*0+(\.0*)?\s*$/
843 && $self->recur =~ /^\s*0+(\.0*)?\s*$/;
844 } elsif ( $self->can('is_free_options') ) {
845 not grep { $_ !~ /^\s*0*(\.0*)?\s*$/ }
846 map { $self->option($_) }
847 $self->is_free_options;
849 warn "FS::part_pkg::is_free: FS::part_pkg::". $self->plan. " subclass ".
850 "provides neither is_free_options nor is_free method; returning false";
855 sub can_discount { 0; }
858 # moved to FS::Misc to make this accessible to other packages
860 FS::Misc::pkg_freqs();
865 Returns an english representation of the I<freq> field, such as "monthly",
866 "weekly", "semi-annually", etc.
872 my $freq = $self->freq;
874 #my $freqs_href = $self->freqs_href;
875 my $freqs_href = freqs_href();
877 if ( exists($freqs_href->{$freq}) ) {
878 $freqs_href->{$freq};
880 my $interval = 'month';
881 if ( $freq =~ /^(\d+)([hdw])$/ ) {
882 my %interval = ( 'h' => 'hour', 'd'=>'day', 'w'=>'week' );
883 $interval = $interval{$2};
888 "every $freq ${interval}s";
893 =item add_freq TIMESTAMP [ FREQ ]
895 Adds a billing period of some frequency to the provided timestamp and
896 returns the resulting timestamp, or -1 if the frequency could not be
897 parsed (shouldn't happen). By default, the frequency of this package
898 will be used; to override this, pass a different frequency as a second
904 my( $self, $date, $freq ) = @_;
905 $freq = $self->freq unless $freq;
907 #change this bit to use Date::Manip? CAREFUL with timezones (see
908 # mailing list archive)
909 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($date) )[0,1,2,3,4,5];
911 if ( $freq =~ /^\d+$/ ) {
913 until ( $mon < 12 ) { $mon -= 12; $year++; }
914 } elsif ( $freq =~ /^(\d+)w$/ ) {
917 } elsif ( $freq =~ /^(\d+)d$/ ) {
920 } elsif ( $freq =~ /^(\d+)h$/ ) {
927 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
932 For backwards compatibility, returns the plandata field as well as all options
933 from FS::part_pkg_option.
939 carp "plandata is deprecated";
941 $self->SUPER::plandata(@_);
943 my $plandata = $self->get('plandata');
944 my %options = $self->options;
945 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
950 =item part_pkg_vendor
952 Returns all vendor/external package ids as FS::part_pkg_vendor objects (see
953 L<FS::part_pkg_vendor>).
957 sub part_pkg_vendor {
959 qsearch('part_pkg_vendor', { 'pkgpart' => $self->pkgpart } );
964 Returns a list of vendor/external package ids by exportnum
970 map { $_->exportnum => $_->vendor_pkg_id } $self->part_pkg_vendor;
973 =item part_pkg_option
975 Returns all options as FS::part_pkg_option objects (see
976 L<FS::part_pkg_option>).
980 sub part_pkg_option {
982 qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
987 Returns a list of option names and values suitable for assigning to a hash.
993 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
996 =item option OPTIONNAME [ QUIET ]
998 Returns the option value for the given name, or the empty string. If a true
999 value is passed as the second argument, warnings about missing the option
1005 my( $self, $opt, $ornull ) = @_;
1006 my $part_pkg_option =
1007 qsearchs('part_pkg_option', {
1008 pkgpart => $self->pkgpart,
1011 return $part_pkg_option->optionvalue if $part_pkg_option;
1012 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
1013 split("\n", $self->get('plandata') );
1014 return $plandata{$opt} if exists $plandata{$opt};
1015 cluck "WARNING: (pkgpart ". $self->pkgpart. ") Package def option $opt ".
1016 "not found in options or plandata!\n"
1021 =item bill_part_pkg_link
1023 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1027 sub bill_part_pkg_link {
1028 shift->_part_pkg_link('bill', @_);
1031 =item svc_part_pkg_link
1033 Returns the associated part_pkg_link records (see L<FS::part_pkg_link>).
1037 sub svc_part_pkg_link {
1038 shift->_part_pkg_link('svc', @_);
1041 sub _part_pkg_link {
1042 my( $self, $type ) = @_;
1043 qsearch({ table => 'part_pkg_link',
1044 hashref => { 'src_pkgpart' => $self->pkgpart,
1045 'link_type' => $type,
1046 #protection against infinite recursive links
1047 'dst_pkgpart' => { op=>'!=', value=> $self->pkgpart },
1049 order_by => "ORDER BY hidden",
1053 sub self_and_bill_linked {
1054 shift->_self_and_linked('bill', @_);
1057 sub _self_and_linked {
1058 my( $self, $type, $hidden ) = @_;
1062 foreach ( ( $self, map { $_->dst_pkg->_self_and_linked($type, $_->hidden) }
1063 $self->_part_pkg_link($type) ) )
1065 $_->hidden($hidden) if $hidden;
1072 =item part_pkg_taxoverride [ CLASS ]
1074 Returns all associated FS::part_pkg_taxoverride objects (see
1075 L<FS::part_pkg_taxoverride>). Limits the returned set to those
1076 of class CLASS if defined. Class may be one of 'setup', 'recur',
1077 the empty string (default), or a usage class number (see L<FS::usage_class>).
1078 When a class is specified, the empty string class (default) is returned
1079 if no more specific values exist.
1083 sub part_pkg_taxoverride {
1087 my $hashref = { 'pkgpart' => $self->pkgpart };
1088 $hashref->{'usage_class'} = $class if defined($class);
1089 my @overrides = qsearch('part_pkg_taxoverride', $hashref );
1091 unless ( scalar(@overrides) || !defined($class) || !$class ){
1092 $hashref->{'usage_class'} = '';
1093 @overrides = qsearch('part_pkg_taxoverride', $hashref );
1099 =item has_taxproduct
1101 Returns true if this package has any taxproduct associated with it.
1105 sub has_taxproduct {
1108 $self->taxproductnum ||
1109 scalar( grep { $_ =~/^usage_taxproductnum_/ && $self->option($_) }
1110 keys %{ {$self->options} }
1116 =item taxproduct [ CLASS ]
1118 Returns the associated tax product for this package definition (see
1119 L<FS::part_pkg_taxproduct>). CLASS may be one of 'setup', 'recur' or
1120 the usage classnum (see L<FS::usage_class>). Returns the default
1121 tax product for this record if the more specific CLASS value does
1130 my $part_pkg_taxproduct;
1132 my $taxproductnum = $self->taxproductnum;
1134 my $class_taxproductnum = $self->option("usage_taxproductnum_$class", 1);
1135 $taxproductnum = $class_taxproductnum
1136 if $class_taxproductnum
1139 $part_pkg_taxproduct =
1140 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1142 unless ($part_pkg_taxproduct || $taxproductnum eq $self->taxproductnum ) {
1143 $taxproductnum = $self->taxproductnum;
1144 $part_pkg_taxproduct =
1145 qsearchs( 'part_pkg_taxproduct', { 'taxproductnum' => $taxproductnum } );
1148 $part_pkg_taxproduct;
1151 =item taxproduct_description [ CLASS ]
1153 Returns the description of the associated tax product for this package
1154 definition (see L<FS::part_pkg_taxproduct>).
1158 sub taxproduct_description {
1160 my $part_pkg_taxproduct = $self->taxproduct(@_);
1161 $part_pkg_taxproduct ? $part_pkg_taxproduct->description : '';
1164 =item part_pkg_taxrate DATA_PROVIDER, GEOCODE, [ CLASS ]
1166 Returns the package to taxrate m2m records for this package in the location
1167 specified by GEOCODE (see L<FS::part_pkg_taxrate>) and usage class CLASS.
1168 CLASS may be one of 'setup', 'recur', or one of the usage classes numbers
1169 (see L<FS::usage_class>).
1173 sub _expand_cch_taxproductnum {
1176 my $part_pkg_taxproduct = $self->taxproduct($class);
1178 my ($a,$b,$c,$d) = ( $part_pkg_taxproduct
1179 ? ( split ':', $part_pkg_taxproduct->taxproduct )
1182 $a = '' unless $a; $b = '' unless $b; $c = '' unless $c; $d = '' unless $d;
1183 my $extra_sql = "AND ( taxproduct = '$a:$b:$c:$d'
1184 OR taxproduct = '$a:$b:$c:'
1185 OR taxproduct = '$a:$b:".":$d'
1186 OR taxproduct = '$a:$b:".":' )";
1187 map { $_->taxproductnum } qsearch( { 'table' => 'part_pkg_taxproduct',
1188 'hashref' => { 'data_vendor'=>'cch' },
1189 'extra_sql' => $extra_sql,
1194 sub part_pkg_taxrate {
1196 my ($data_vendor, $geocode, $class) = @_;
1199 my $extra_sql = 'WHERE part_pkg_taxproduct.data_vendor = '.
1200 dbh->quote($data_vendor);
1202 # CCH oddness in m2m
1203 $extra_sql .= ' AND ('.
1204 join(' OR ', map{ 'geocode = '. $dbh->quote(substr($geocode, 0, $_)) }
1208 # much more CCH oddness in m2m -- this is kludgy
1209 my @tpnums = $self->_expand_cch_taxproductnum($class);
1210 if (scalar(@tpnums)) {
1211 $extra_sql .= ' AND ('.
1212 join(' OR ', map{ "taxproductnum = $_" } @tpnums ).
1215 $extra_sql .= ' AND ( 0 = 1 )';
1218 my $addl_from = 'LEFT JOIN part_pkg_taxproduct USING ( taxproductnum )';
1219 my $order_by = 'ORDER BY taxclassnum, length(geocode) desc, length(taxproduct) desc';
1220 my $select = 'DISTINCT ON(taxclassnum) *, taxproduct';
1222 # should qsearch preface columns with the table to facilitate joins?
1223 qsearch( { 'table' => 'part_pkg_taxrate',
1224 'select' => $select,
1225 'hashref' => { # 'data_vendor' => $data_vendor,
1226 # 'taxproductnum' => $self->taxproductnum,
1228 'addl_from' => $addl_from,
1229 'extra_sql' => $extra_sql,
1230 'order_by' => $order_by,
1234 =item part_pkg_discount
1236 Returns the package to discount m2m records (see L<FS::part_pkg_discount>)
1241 sub part_pkg_discount {
1243 qsearch('part_pkg_discount', { 'pkgpart' => $self->pkgpart });
1248 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
1249 PLAN is the object's I<plan> field. There should be better docs
1250 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
1256 my $plan = $self->plan;
1258 cluck "no price plan found for pkgpart ". $self->pkgpart. "\n"
1262 return $self if ref($self) =~ /::$plan$/; #already blessed into plan subclass
1263 my $class = ref($self). "::$plan";
1264 warn "reblessing $self into $class" if $DEBUG;
1267 bless($self, $class) unless $@;
1271 #fallbacks that eval the setup and recur fields, for backwards compat
1275 warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
1276 $self->_calc_eval('setup', @_);
1281 warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
1282 $self->_calc_eval('recur', @_);
1285 use vars qw( $sdate @details );
1287 #my( $self, $field, $cust_pkg ) = @_;
1288 my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
1290 *details = $detailsref;
1291 $self->$field() =~ /^(.*)$/
1292 or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
1293 $self->$field(). "\n";
1295 return 0 if $prog =~ /^\s*$/;
1296 my $value = eval $prog;
1301 #fallback that return 0 for old legacy packages with no plan
1303 sub calc_remain { 0; }
1304 sub calc_cancel { 0; }
1305 sub calc_units { 0; }
1307 #fallback for everything except bulk.pm
1308 sub hide_svc_detail { 0; }
1310 =item recur_cost_permonth CUST_PKG
1312 recur_cost divided by freq (only supported for monthly and longer frequencies)
1316 sub recur_cost_permonth {
1317 my($self, $cust_pkg) = @_;
1318 return 0 unless $self->freq =~ /^\d+$/ && $self->freq > 0;
1319 sprintf('%.2f', $self->recur_cost / $self->freq );
1322 =item format OPTION DATA
1324 Returns data formatted according to the function 'format' described
1325 in the plan info. Returns DATA if no such function exists.
1330 my ($self, $option, $data) = (shift, shift, shift);
1331 if (exists($plans{$self->plan}->{fields}->{$option}{format})) {
1332 &{$plans{$self->plan}->{fields}->{$option}{format}}($data);
1338 =item parse OPTION DATA
1340 Returns data parsed according to the function 'parse' described
1341 in the plan info. Returns DATA if no such function exists.
1346 my ($self, $option, $data) = (shift, shift, shift);
1347 if (exists($plans{$self->plan}->{fields}->{$option}{parse})) {
1348 &{$plans{$self->plan}->{fields}->{$option}{parse}}($data);
1358 =head1 CLASS METHODS
1366 # Used by FS::Upgrade to migrate to a new database.
1368 sub _upgrade_data { # class method
1369 my($class, %opts) = @_;
1371 warn "[FS::part_pkg] upgrading $class\n" if $DEBUG;
1373 my @part_pkg = qsearch({
1374 'table' => 'part_pkg',
1375 'extra_sql' => "WHERE ". join(' OR ',
1376 ( map "($_ IS NOT NULL AND $_ != '' )",
1377 qw( plandata setup recur ) ),
1378 'plan IS NULL', "plan = '' ",
1382 foreach my $part_pkg (@part_pkg) {
1384 unless ( $part_pkg->plan ) {
1385 $part_pkg->plan('flat');
1388 if ( length($part_pkg->option('setup_fee')) == 0
1389 && $part_pkg->setup =~ /^\s*([\d\.]+)\s*$/ ) {
1391 my $opt = new FS::part_pkg_option {
1392 'pkgpart' => $part_pkg->pkgpart,
1393 'optionname' => 'setup_fee',
1394 'optionvalue' => $1,
1396 my $error = $opt->insert;
1397 die $error if $error;
1401 # die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1402 # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1404 $part_pkg->setup('');
1406 if ( length($part_pkg->option('recur_fee')) == 0
1407 && $part_pkg->recur =~ /^\s*([\d\.]+)\s*$/ ) {
1409 my $opt = new FS::part_pkg_option {
1410 'pkgpart' => $part_pkg->pkgpart,
1411 'optionname' => 'recur_fee',
1412 'optionvalue' => $1,
1414 my $error = $opt->insert;
1415 die $error if $error;
1419 # die "Can't parse part_pkg.setup for fee; convert pkgnum ".
1420 # $part_pkg->pkgnum. " manually: ". $part_pkg->setup. "\n";
1422 $part_pkg->recur('');
1424 $part_pkg->replace; #this should take care of plandata, right?
1428 # now upgrade to the explicit custom flag
1430 @part_pkg = qsearch({
1431 'table' => 'part_pkg',
1432 'hashref' => { disabled => 'Y', custom => '' },
1433 'extra_sql' => "AND comment LIKE '(CUSTOM) %'",
1436 foreach my $part_pkg (@part_pkg) {
1437 my $new = new FS::part_pkg { $part_pkg->hash };
1439 my $comment = $part_pkg->comment;
1440 $comment =~ s/^\(CUSTOM\) //;
1441 $comment = '(none)' unless $comment =~ /\S/;
1442 $new->comment($comment);
1444 my $pkg_svc = { map { $_->svcpart => $_->quantity } $part_pkg->pkg_svc };
1445 my $primary = $part_pkg->svcpart;
1446 my $options = { $part_pkg->options };
1448 my $error = $new->replace( $part_pkg,
1449 'pkg_svc' => $pkg_svc,
1450 'primary_svc' => $primary,
1451 'options' => $options,
1453 die $error if $error;
1458 =item curuser_pkgs_sql
1460 Returns an SQL fragment for searching for packages the current user can
1461 use, either via part_pkg.agentnum directly, or via agent type (see
1466 sub curuser_pkgs_sql {
1469 $class->_pkgs_sql( $FS::CurrentUser::CurrentUser->agentnums );
1473 =item agent_pkgs_sql AGENT | AGENTNUM, ...
1475 Returns an SQL fragment for searching for packages the provided agent or agents
1476 can use, either via part_pkg.agentnum directly, or via agent type (see
1481 sub agent_pkgs_sql {
1482 my $class = shift; #i'm a class method, not a sub (the question is... why??)
1483 my @agentnums = map { ref($_) ? $_->agentnum : $_ } @_;
1485 $class->_pkgs_sql(@agentnums); #is this why
1490 my( $class, @agentnums ) = @_;
1491 my $agentnums = join(',', @agentnums);
1495 ( agentnum IS NOT NULL AND agentnum IN ($agentnums) )
1496 OR ( agentnum IS NULL
1497 AND EXISTS ( SELECT 1
1499 LEFT JOIN agent_type USING ( typenum )
1500 LEFT JOIN agent AS typeagent USING ( typenum )
1501 WHERE type_pkgs.pkgpart = part_pkg.pkgpart
1502 AND typeagent.agentnum IN ($agentnums)
1520 #false laziness w/part_export & cdr
1522 foreach my $INC ( @INC ) {
1523 warn "globbing $INC/FS/part_pkg/*.pm\n" if $DEBUG;
1524 foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
1525 warn "attempting to load plan info from $file\n" if $DEBUG;
1526 $file =~ /\/(\w+)\.pm$/ or do {
1527 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
1531 my $info = eval "use FS::part_pkg::$mod; ".
1532 "\\%FS::part_pkg::$mod\::info;";
1534 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
1537 unless ( keys %$info ) {
1538 warn "no %info hash found in FS::part_pkg::$mod, skipping\n";
1541 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
1542 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
1543 warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
1546 $info{$mod} = $info;
1550 tie %plans, 'Tie::IxHash',
1551 map { $_ => $info{$_} }
1552 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
1562 =head1 NEW PLAN CLASSES
1564 A module should be added in FS/FS/part_pkg/ Eventually, an example may be
1565 found in eg/plan_template.pm. Until then, it is suggested that you use the
1566 other modules in FS/FS/part_pkg/ as a guide.
1570 The delete method is unimplemented.
1572 setup and recur semantics are not yet defined (and are implemented in
1573 FS::cust_bill. hmm.). now they're deprecated and need to go.
1577 part_pkg_taxrate is Pg specific
1579 replace should be smarter about managing the related tables (options, pkg_svc)
1583 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
1584 schema.html from the base documentation.