4 use vars qw( @ISA %freq %plans $DEBUG );
5 use Carp qw(carp cluck);
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 promo_code - Promotional code
59 =item setup - Setup fee expression (deprecated)
61 =item freq - Frequency of recurring fee
63 =item recur - Recurring fee expression (deprecated)
65 =item setuptax - Setup fee tax exempt flag, empty or `Y'
67 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
69 =item taxclass - Tax class
71 =item plan - Price plan
73 =item plandata - Price plan data (deprecated - see L<FS::part_pkg_option> instead)
75 =item disabled - Disabled flag, empty or `Y'
85 Creates a new package definition. To add the package definition to
86 the database, see L<"insert">.
90 sub table { 'part_pkg'; }
94 An alternate constructor. Creates a new package definition by duplicating
95 an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended
96 to the comment field. To add the package definition to the database, see
103 my $class = ref($self);
104 my %hash = $self->hash;
105 $hash{'pkgpart'} = '';
106 $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
107 unless $hash{'comment'} =~ /^\(CUSTOM\) /;
108 #new FS::part_pkg ( \%hash ); # ?
109 new $class ( \%hash ); # ?
114 Adds this package definition to the database. If there is an error,
115 returns the error, otherwise returns false.
121 warn "FS::part_pkg::insert called on $self" if $DEBUG;
123 local $SIG{HUP} = 'IGNORE';
124 local $SIG{INT} = 'IGNORE';
125 local $SIG{QUIT} = 'IGNORE';
126 local $SIG{TERM} = 'IGNORE';
127 local $SIG{TSTP} = 'IGNORE';
128 local $SIG{PIPE} = 'IGNORE';
130 my $oldAutoCommit = $FS::UID::AutoCommit;
131 local $FS::UID::AutoCommit = 0;
134 warn " saving legacy plandata" if $DEBUG;
135 my $plandata = $self->get('plandata');
136 $self->set('plandata', '');
138 warn " inserting part_pkg record" if $DEBUG;
139 my $error = $self->SUPER::insert;
141 $dbh->rollback if $oldAutoCommit;
146 warn " inserting part_pkg_option records for plandata" if $DEBUG;
147 foreach my $part_pkg_option (
148 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
149 return "illegal plandata: $plandata";
151 new FS::part_pkg_option {
152 'pkgpart' => $self->pkgpart,
157 split("\n", $plandata)
159 my $error = $part_pkg_option->insert;
161 $dbh->rollback if $oldAutoCommit;
167 my $conf = new FS::Conf;
168 if ( $conf->exists('agent_defaultpkg') ) {
169 warn " agent_defaultpkg set; allowing all agents to purchase package"
171 foreach my $agent_type ( qsearch('agent_type', {} ) ) {
172 my $type_pkgs = new FS::type_pkgs({
173 'typenum' => $agent_type->typenum,
174 'pkgpart' => $self->pkgpart,
176 my $error = $type_pkgs->insert;
178 $dbh->rollback if $oldAutoCommit;
184 warn " commiting transaction" if $DEBUG;
185 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 Currently unimplemented.
197 return "Can't (yet?) delete package definitions.";
198 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
201 =item replace OLD_RECORD
203 Replaces OLD_RECORD with this one in the database. If there is an error,
204 returns the error, otherwise returns false.
209 my( $new, $old ) = ( shift, shift );
211 local $SIG{HUP} = 'IGNORE';
212 local $SIG{INT} = 'IGNORE';
213 local $SIG{QUIT} = 'IGNORE';
214 local $SIG{TERM} = 'IGNORE';
215 local $SIG{TSTP} = 'IGNORE';
216 local $SIG{PIPE} = 'IGNORE';
218 my $oldAutoCommit = $FS::UID::AutoCommit;
219 local $FS::UID::AutoCommit = 0;
222 my $plandata = $new->get('plandata');
223 $new->set('plandata', '');
225 foreach my $part_pkg_option ( $old->part_pkg_option ) {
226 my $error = $part_pkg_option->delete;
228 $dbh->rollback if $oldAutoCommit;
233 my $error = $new->SUPER::replace($old);
235 $dbh->rollback if $oldAutoCommit;
239 foreach my $part_pkg_option (
240 map { /^(\w+)=(.*)$/ or do { $dbh->rollback if $oldAutoCommit;
241 return "illegal plandata: $plandata";
243 new FS::part_pkg_option {
244 'pkgpart' => $new->pkgpart,
249 split("\n", $plandata)
251 my $error = $part_pkg_option->insert;
253 $dbh->rollback if $oldAutoCommit;
258 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
264 Checks all fields to make sure this is a valid package definition. If
265 there is an error, returns the error, otherwise returns false. Called by the
266 insert and replace methods.
272 warn "FS::part_pkg::check called on $self" if $DEBUG;
274 for (qw(setup recur plandata)) {
275 #$self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
276 return "Use of $_ field is deprecated; set a plan and options"
277 if length($self->get($_));
281 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
282 my $error = $self->ut_number('freq');
283 return $error if $error;
285 $self->freq =~ /^(\d+[dw]?)$/
286 or return "Illegal or empty freq: ". $self->freq;
290 my $error = $self->ut_numbern('pkgpart')
291 || $self->ut_text('pkg')
292 || $self->ut_text('comment')
293 || $self->ut_textn('promo_code')
294 || $self->ut_alphan('plan')
295 || $self->ut_enum('setuptax', [ '', 'Y' ] )
296 || $self->ut_enum('recurtax', [ '', 'Y' ] )
297 || $self->ut_textn('taxclass')
298 || $self->ut_enum('disabled', [ '', 'Y' ] )
299 || $self->SUPER::check
301 return $error if $error;
303 return 'Unknown plan '. $self->plan
304 unless exists($plans{$self->plan});
311 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
312 definition (with non-zero quantity).
318 #sort { $b->primary cmp $a->primary }
319 grep { $_->quantity }
320 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
323 =item svcpart [ SVCDB ]
325 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
326 associated with this package definition (see L<FS::pkg_svc>). Returns
327 false if there not a primary service definition or exactly one service
328 definition with quantity 1, or if SVCDB is specified and does not match the
329 svcdb of the service definition,
335 my $svcdb = scalar(@_) ? shift : '';
337 grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
339 @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
340 if dbdef->table('pkg_svc')->column('primary_svc');
341 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
343 return '' if scalar(@pkg_svc) != 1;
344 $pkg_svc[0]->svcpart;
349 Returns a list of the acceptable payment types for this package. Eventually
350 this should come out of a database table and be editable, but currently has the
351 following logic instead;
353 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
354 returned, otherwise, the single item B<CARD> is returned.
356 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
362 #if ( $self->setup == 0 && $self->recur == 0 ) {
363 if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/
364 && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
373 Returns an english representation of the I<freq> field, such as "monthly",
374 "weekly", "semi-annually", etc.
378 tie %freq, 'Tie::IxHash',
379 '0' => '(no recurring fee)',
382 '2w' => 'biweekly (every 2 weeks)',
384 '2' => 'bimonthly (every 2 months)',
385 '3' => 'quarterly (every 3 months)',
386 '6' => 'semiannually (every 6 months)',
388 '24' => 'biannually (every 2 years)',
393 my $freq = $self->freq;
394 if ( exists($freq{$freq}) ) {
397 my $interval = 'month';
398 if ( $freq =~ /^(\d+)([dw])$/ ) {
399 my %interval = ( 'd'=>'day', 'w'=>'week' );
400 $interval = $interval{$2};
405 "every $freq ${interval}s";
412 For backwards compatibility, returns the plandata field as well as all options
413 from FS::part_pkg_option.
419 carp "plandata is deprecated";
421 $self->SUPER::plandata(@_);
423 my $plandata = $self->get('plandata');
424 my %options = $self->options;
425 $plandata .= join('', map { "$_=$options{$_}\n" } keys %options );
430 =item part_pkg_option
432 Returns all options as FS::part_pkg_option objects (see
433 L<FS::part_pkg_option>).
437 sub part_pkg_option {
439 qsearch('part_pkg_option', { 'pkgpart' => $self->pkgpart } );
444 Returns a list of option names and values suitable for assigning to a hash.
450 map { $_->optionname => $_->optionvalue } $self->part_pkg_option;
453 =item option OPTIONNAME
455 Returns the option value for the given name, or the empty string.
460 my( $self, $opt ) = @_;
461 my $part_pkg_option =
462 qsearchs('part_pkg_option', {
463 pkgpart => $self->pkgpart,
466 return $part_pkg_option->optionvalue if $part_pkg_option;
467 my %plandata = map { /^(\w+)=(.*)$/; ( $1 => $2 ); }
468 split("\n", $self->get('plandata') );
469 return $plandata{$opt} if exists $plandata{$opt};
470 cluck "Package definition option $opt not found in options or plandata!\n";
476 Reblesses the object into the FS::part_pkg::PLAN class (if available), where
477 PLAN is the object's I<plan> field. There should be better docs
478 on how to create new price plans, but until then, see L</NEW PLAN CLASSES>.
484 my $plan = $self->plan;
485 my $class = ref($self). "::$plan";
488 bless($self, $class) unless $@;
492 #fallbacks that eval the setup and recur fields, for backwards compat
496 warn 'no price plan class for '. $self->plan. ", eval-ing setup\n";
497 $self->_calc_eval('setup', @_);
502 warn 'no price plan class for '. $self->plan. ", eval-ing recur\n";
503 $self->_calc_eval('recur', @_);
506 use vars qw( $sdate @details );
508 #my( $self, $field, $cust_pkg ) = @_;
509 my( $self, $field, $cust_pkg, $sdateref, $detailsref ) = @_;
511 *details = $detailsref;
512 $self->$field() =~ /^(.*)$/
513 or die "Illegal $field (pkgpart ". $self->pkgpart. '): '.
514 $self->$field(). "\n";
516 return 0 if $prog =~ /^\s*$/;
517 my $value = eval $prog;
533 foreach my $INC ( @INC ) {
534 foreach my $file ( glob("$INC/FS/part_pkg/*.pm") ) {
535 warn "attempting to load plan info from $file\n" if $DEBUG;
536 $file =~ /\/(\w+)\.pm$/ or do {
537 warn "unrecognized file in $INC/FS/part_pkg/: $file\n";
541 my $info = eval "use FS::part_pkg::$mod; ".
542 "\\%FS::part_pkg::$mod\::info;";
544 die "error using FS::part_pkg::$mod (skipping): $@\n" if $@;
547 unless ( keys %$info ) {
548 warn "no %info hash found in FS::part_pkg::$mod, skipping\n"
549 unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck
552 warn "got plan info from FS::part_pkg::$mod: $info\n" if $DEBUG;
553 if ( exists($info->{'disabled'}) && $info->{'disabled'} ) {
554 warn "skipping disabled plan FS::part_pkg::$mod" if $DEBUG;
561 tie %plans, 'Tie::IxHash',
562 map { $_ => $info{$_} }
563 sort { $info{$a}->{'weight'} <=> $info{$b}->{'weight'} }
572 =head1 NEW PLAN CLASSES
574 A module should be added in FS/FS/part_pkg/ (an example may be found in
579 The delete method is unimplemented.
581 setup and recur semantics are not yet defined (and are implemented in
582 FS::cust_bill. hmm.).
586 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
587 schema.html from the base documentation.