4 use vars qw( @ISA %freq %plans $DEBUG );
8 use FS::Record qw( qsearch qsearchs dbh dbdef );
12 use FS::part_pkg_option;
14 @ISA = qw( FS::Record );
20 FS::part_pkg - Object methods for part_pkg objects
26 $record = new FS::part_pkg \%hash
27 $record = new FS::part_pkg { 'column' => 'value' };
29 $custom_record = $template_record->clone;
31 $error = $record->insert;
33 $error = $new_record->replace($old_record);
35 $error = $record->delete;
37 $error = $record->check;
39 @pkg_svc = $record->pkg_svc;
41 $svcnum = $record->svcpart;
42 $svcnum = $record->svcpart( 'svc_acct' );
46 An FS::part_pkg object represents a package definition. FS::part_pkg
47 inherits from FS::Record. The following fields are currently supported:
51 =item pkgpart - primary key (assigned automatically for new package definitions)
53 =item pkg - Text name of this package definition (customer-viewable)
55 =item comment - Text name of this package definition (non-customer-viewable)
57 =item setup - Setup fee expression (deprecated)
59 =item freq - Frequency of recurring fee
61 =item recur - Recurring fee expression (deprecated)
63 =item setuptax - Setup fee tax exempt flag, empty or `Y'
65 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
67 =item taxclass - Tax class
69 =item plan - Price plan
71 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
73 =item disabled - Disabled flag, empty or `Y'
83 Creates a new package definition. To add the package definition to
84 the database, see L<"insert">.
88 sub table { 'part_pkg'; }
92 An alternate constructor. Creates a new package definition by duplicating
93 an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended
94 to the comment field. To add the package definition to the database, see
101 my $class = ref($self);
102 my %hash = $self->hash;
103 $hash{'pkgpart'} = '';
104 $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
105 unless $hash{'comment'} =~ /^\(CUSTOM\) /;
106 #new FS::part_pkg ( \%hash ); # ?
107 new $class ( \%hash ); # ?
112 Adds this package definition to the database. If there is an error,
113 returns the error, otherwise returns false.
119 warn "FS::part_pkg::insert called on $self" if $DEBUG;
121 local $SIG{HUP} = 'IGNORE';
122 local $SIG{INT} = 'IGNORE';
123 local $SIG{QUIT} = 'IGNORE';
124 local $SIG{TERM} = 'IGNORE';
125 local $SIG{TSTP} = 'IGNORE';
126 local $SIG{PIPE} = 'IGNORE';
128 my $oldAutoCommit = $FS::UID::AutoCommit;
129 local $FS::UID::AutoCommit = 0;
132 warn " saving legacy plandata" if $DEBUG;
133 my $plandata = $self->get('plandata');
134 $self->set('plandata', '');
136 warn " inserting part_pkg record" if $DEBUG;
137 my $error = $self->SUPER::insert;
139 $dbh->rollback if $oldAutoCommit;
144 warn " inserting part_pkg_option records for plandata" if $DEBUG;
145 foreach my $part_pkg_option (
146 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
147 return "illegal plandata: $plandata";
149 new FS::part_pkg_option {
150 'pkgpart' => $self->pkgpart,
155 split("\n", $plandata)
157 my $error = $part_pkg_option->insert;
159 $dbh->rollback if $oldAutoCommit;
165 my $conf = new FS::Conf;
166 if ( $conf->exists('agent_defaultpkg') ) {
167 warn " agent_defaultpkg set; allowing all agents to purchase package"
169 foreach my $agent_type ( qsearch('agent_type', {} ) ) {
170 my $type_pkgs = new FS::type_pkgs({
171 'typenum' => $agent_type->typenum,
172 'pkgpart' => $self->pkgpart,
174 my $error = $type_pkgs->insert;
176 $dbh->rollback if $oldAutoCommit;
182 warn " commiting transaction" if $DEBUG;
183 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
190 Currently unimplemented.
195 return "Can't (yet?) delete package definitions.";
196 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
199 =item replace OLD_RECORD
201 Replaces OLD_RECORD with this one in the database. If there is an error,
202 returns the error, otherwise returns false.
207 my( $new, $old ) = ( shift, shift );
209 local $SIG{HUP} = 'IGNORE';
210 local $SIG{INT} = 'IGNORE';
211 local $SIG{QUIT} = 'IGNORE';
212 local $SIG{TERM} = 'IGNORE';
213 local $SIG{TSTP} = 'IGNORE';
214 local $SIG{PIPE} = 'IGNORE';
216 my $oldAutoCommit = $FS::UID::AutoCommit;
217 local $FS::UID::AutoCommit = 0;
220 my $plandata = $new->get('plandata');
221 $new->set('plandata', '');
223 foreach my $part_pkg_option ( $old->part_pkg_option ) {
224 my $error = $part_pkg_option->delete;
226 $dbh->rollback if $oldAutoCommit;
231 my $error = $new->SUPER::replace($old);
233 $dbh->rollback if $oldAutoCommit;
237 foreach my $part_pkg_option (
238 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
239 return "illegal plandata: $plandata";
241 new FS::part_pkg_option {
242 'pkgpart' => $new->pkgpart,
247 split("\n", $plandata)
249 my $error = $part_pkg_option->insert;
251 $dbh->rollback if $oldAutoCommit;
256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
262 Checks all fields to make sure this is a valid package definition. If
263 there is an error, returns the error, otherwise returns false. Called by the
264 insert and replace methods.
270 warn "FS::part_pkg::check called on $self" if $DEBUG;
272 for (qw(setup recur plandata)) {
273 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
274 return "Use of $_ field is deprecated; set a plan and options"
275 if length($self->get($_));
279 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
280 my $error = $self->ut_number('freq');
281 return $error if $error;
283 $self->freq =~ /^(\d+[dw]?)$/
284 or return "Illegal or empty freq: ". $self->freq;
288 my $error = $self->ut_numbern('pkgpart')
289 || $self->ut_text('pkg')
290 || $self->ut_text('comment')
291 || $self->ut_alphan('plan')
292 || $self->ut_enum('setuptax', [ '', 'Y' ] )
293 || $self->ut_enum('recurtax', [ '', 'Y' ] )
294 || $self->ut_textn('taxclass')
295 || $self->ut_enum('disabled', [ '', 'Y' ] )
296 || $self->SUPER::check
298 return $error if $error;
300 return 'Unknown plan '. $self->plan
301 unless exists($plans{$self->plan});
308 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
309 definition (with non-zero quantity).
315 #sort { $b->primary cmp $a->primary }
316 grep { $_->quantity }
317 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
320 =item svcpart [ SVCDB ]
322 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
323 associated with this package definition (see L<FS::pkg_svc>). Returns
324 false if there not a primary service definition or exactly one service
325 definition with quantity 1, or if SVCDB is specified and does not match the
326 svcdb of the service definition,
332 my $svcdb = scalar(@_) ? shift : '';
334 grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
336 @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
337 if dbdef->table('pkg_svc')->column('primary_svc');
338 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
340 return '' if scalar(@pkg_svc) != 1;
341 $pkg_svc[0]->svcpart;
346 Returns a list of the acceptable payment types for this package. Eventually
347 this should come out of a database table and be editable, but currently has the
348 following logic instead;
350 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
351 returned, otherwise, the single item B<CARD> is returned.
353 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
359 #if ( $self->setup == 0 && $self->recur == 0 ) {
360 if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/
361 && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
370 Returns an english representation of the I<freq> field, such as "monthly",
371 "weekly", "semi-annually", etc.
375 tie %freq, 'Tie::IxHash',
376 '0' => '(no recurring fee)',
379 '2w' => 'biweekly (every 2 weeks)',
381 '2' => 'bimonthly (every 2 months)',
382 '3' => 'quarterly (every 3 months)',
383 '6' => 'semiannually (every 6 months)',
385 '24' => 'biannually (every 2 years)',
390 my $freq = $self->freq;
391 if ( exists($freq{$freq}) ) {
394 my $interval = 'month';
395 if ( $freq =~ /^(\d+)([dw])$/ ) {
396 my %interval = ( 'd'=>'day', 'w'=>'week' );
397 $interval = $interval{$2};
402 "every $freq ${interval}s";
409 For backwards compatibility, returns the plandata field as well as all options
410 from FS::part_pkg_option.
416 carp "plandata is deprecated";
418 $self->SUPER::plandata(@_);
420 my $plandata = $self->get('plandata');
421 my %options = $self->options;
422 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
427 =item part_pkg_option
429 Returns all options as FS::part_pkg_option objects (see
430 L<FS::part_pkg_option>).
434 sub part_pkg_option {
436 qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
441 Returns a list of option names and values suitable for assigning to a hash.
447 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
450 =item option OPTIONNAME
452 Returns the option value for the given name, or the empty string.
457 my( $self, $opt ) = @_;
458 my $part_pkg_option =
459 qsearchs('part_pkg_option', {
460 pkgpart => $self->pkgpart,
463 return $part_pkg_option->optionvalue if $part_pkg_option;
464 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
465 split("\n", $self->plandata );
466 return $plandata{$opt} if exists $plandata{$opt};
467 cluck "Package definition option $opt not found in options or plandata!\n";
473 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
474 PLAN is the object's I<plan> field. There should be better docs
475 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
481 my $plan = $self->plan;
482 my $class = ref($self). "::$plan";
485 bless($self, $class) unless $@;
489 #fallbacks that eval the setup and recur fields, for backwards compat
493 warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
494 $self->_calc_eval('setup', @_);
499 warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
500 $self->_calc_eval('recur', @_);
503 use vars qw( $sdate @details );
505 #my( $self, $field, $cust_pkg ) = @_;
506 my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
508 *details = $detailsref;
509 $self->$field() =~ /^(.*)$/
510 or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
511 $self->$field(). "\n";
513 return 0 if $prog =~ /^\s*$/;
514 my $value = eval $prog;
530 foreach my $INC ( @INC ) {
531 foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
532 warn "attempting to load plan info from $file\n" if $DEBUG;
533 $file =~ /\/(\w+)\.pm$/ or do {
534 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
538 my $info = eval "use FS::part_pkg::$mod; ".
539 "\\%FS::part_pkg::$mod\::info;";
541 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
544 unless ( keys %$info ) {
545 warn "no %info hash found in FS::part_pkg::$mod, skipping\n"
546 unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
549 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
550 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
551 warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
558 tie %plans, 'Tie::IxHash',
559 map { $_ => $info{$_} }
560 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
569 =head1 NEW PLAN CLASSES
571 A module should be added in FS/FS/part_pkg/ (an example may be found in
576 The delete method is unimplemented.
578 setup and recur semantics are not yet defined (and are implemented in
579 FS::cust_bill. hmm.).
583 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
584 schema.html from the base documentation.