4 use vars qw( @ISA $DEBUG );
5 use FS::Record qw( qsearch dbh dbdef );
13 @ISA = qw( FS::Record );
19 FS::part_pkg - Object methods for part_pkg objects
25 $record = new FS::part_pkg \%hash
26 $record = new FS::part_pkg { 'column' => 'value' };
28 $custom_record = $template_record->clone;
30 $error = $record->insert;
32 $error = $new_record->replace($old_record);
34 $error = $record->delete;
36 $error = $record->check;
38 @pkg_svc = $record->pkg_svc;
40 $svcnum = $record->svcpart;
41 $svcnum = $record->svcpart( 'svc_acct' );
45 An FS::part_pkg object represents a billing item definition. FS::part_pkg
46 inherits from FS::Record. The following fields are currently supported:
50 =item pkgpart - primary key (assigned automatically for new billing item definitions)
52 =item pkg - Text name of this billing item definition (customer-viewable)
54 =item comment - Text name of this billing item definition (non-customer-viewable)
56 =item setup - Setup fee expression
58 =item freq - Frequency of recurring fee
60 =item recur - Recurring fee expression
62 =item setuptax - Setup fee tax exempt flag, empty or `Y'
64 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
66 =item taxclass - Tax class flag
68 =item plan - Price plan
70 =item plandata - Price plan data
72 =item disabled - Disabled flag, empty or `Y'
76 setup and recur are evaluated as Safe perl expressions. You can use numbers
77 just as you would normally. More advanced semantics are not yet defined.
85 Creates a new billing item definition. To add the billing item definition to
86 the database, see L<"insert">.
90 sub table { 'part_pkg'; }
94 An alternate constructor. Creates a new billing item definition by duplicating
95 an existing definition. A new pkgpart is assigned and `(CUSTOM) ' is prepended
96 to the comment field. To add the billing item 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 ); # ?
112 =item insert [ , OPTION => VALUE ... ]
114 Adds this billing item definition to the database. If there is an error,
115 returns the error, otherwise returns false.
117 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
120 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
121 values, appropriate FS::pkg_svc records will be inserted.
123 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
124 FS::pkg_svc record will be updated.
126 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
127 record itself), the object will be updated to point to this package definition.
129 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
130 the scalar will be updated with the custnum value from the cust_pkg record.
137 warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
139 local $SIG{HUP} = 'IGNORE';
140 local $SIG{INT} = 'IGNORE';
141 local $SIG{QUIT} = 'IGNORE';
142 local $SIG{TERM} = 'IGNORE';
143 local $SIG{TSTP} = 'IGNORE';
144 local $SIG{PIPE} = 'IGNORE';
146 my $oldAutoCommit = $FS::UID::AutoCommit;
147 local $FS::UID::AutoCommit = 0;
150 my $error = $self->SUPER::insert;
152 $dbh->rollback if $oldAutoCommit;
156 my $conf = new FS::Conf;
158 if ( $conf->exists('agent_defaultpkg') ) {
159 foreach my $agent_type ( qsearch('agent_type', {} ) ) {
160 my $type_pkgs = new FS::type_pkgs({
161 'typenum' => $agent_type->typenum,
162 'pkgpart' => $self->pkgpart,
164 my $error = $type_pkgs->insert;
166 $dbh->rollback if $oldAutoCommit;
172 warn " inserting pkg_svc records" if $DEBUG;
173 my $pkg_svc = $options{'pkg_svc'} || {};
174 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
175 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
176 my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
178 my $pkg_svc = new FS::pkg_svc( {
179 'pkgpart' => $self->pkgpart,
180 'svcpart' => $part_svc->svcpart,
181 'quantity' => $quantity,
182 'primary_svc' => $primary_svc,
184 my $error = $pkg_svc->insert;
186 $dbh->rollback if $oldAutoCommit;
191 if ( $options{'cust_pkg'} ) {
192 warn " updating cust_pkg record " if $DEBUG;
194 ref($options{'cust_pkg'})
195 ? $options{'cust_pkg'}
196 : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
197 ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
198 if $options{'custnum_ref'};
199 my %hash = $old_cust_pkg->hash;
200 $hash{'pkgpart'} = $self->pkgpart,
201 my $new_cust_pkg = new FS::cust_pkg \%hash;
202 local($FS::cust_pkg::disable_agentcheck) = 1;
203 my $error = $new_cust_pkg->replace($old_cust_pkg);
205 $dbh->rollback if $oldAutoCommit;
206 return "Error modifying cust_pkg record: $error";
210 warn " commiting transaction" if $DEBUG;
211 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
218 Currently unimplemented.
223 return "Can't (yet?) delete package definitions.";
224 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
227 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
229 Replaces OLD_RECORD with this one in the database. If there is an error,
230 returns the error, otherwise returns false.
232 Currently available options are: I<pkg_svc> and I<primary_svc>
234 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
235 values, the appropriate FS::pkg_svc records will be replace.
237 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
238 FS::pkg_svc record will be updated.
243 my( $new, $old ) = ( shift, shift );
245 warn "FS::part_pkg::replace called on $new to replace $old ".
246 "with options %options"
249 local $SIG{HUP} = 'IGNORE';
250 local $SIG{INT} = 'IGNORE';
251 local $SIG{QUIT} = 'IGNORE';
252 local $SIG{TERM} = 'IGNORE';
253 local $SIG{TSTP} = 'IGNORE';
254 local $SIG{PIPE} = 'IGNORE';
256 my $oldAutoCommit = $FS::UID::AutoCommit;
257 local $FS::UID::AutoCommit = 0;
260 warn " replacing part_pkg record" if $DEBUG;
261 my $error = $new->SUPER::replace($old);
263 $dbh->rollback if $oldAutoCommit;
267 warn " replacing pkg_svc records" if $DEBUG;
268 my $pkg_svc = $options{'pkg_svc'} || {};
269 foreach my $part_svc ( qsearch('part_svc', {} ) ) {
270 my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
271 my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
273 my $old_pkg_svc = qsearchs('pkg_svc', {
274 'pkgpart' => $old->pkgpart,
275 'svcpart' => $part_svc->svcpart,
277 my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
278 my $old_primary_svc =
279 ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
280 ? $old_pkg_svc->primary_svc
282 next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
284 my $new_pkg_svc = new FS::pkg_svc( {
285 'pkgpart' => $new->pkgpart,
286 'svcpart' => $part_svc->svcpart,
287 'quantity' => $quantity,
288 'primary_svc' => $primary_svc,
290 my $error = $old_pkg_svc
291 ? $new_pkg_svc->replace($old_pkg_svc)
292 : $new_pkg_svc->insert;
294 $dbh->rollback if $oldAutoCommit;
299 warn " commiting transaction" if $DEBUG;
300 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
306 Checks all fields to make sure this is a valid billing item definition. If
307 there is an error, returns the error, otherwise returns false. Called by the
308 insert and replace methods.
315 for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
317 my $conf = new FS::Conf;
318 if ( $conf->exists('safe-part_pkg') ) {
320 my $error = $self->ut_anything('setup')
321 || $self->ut_anything('recur');
322 return $error if $error;
324 my $s = $self->setup;
326 $s =~ /^\s*\d*\.?\d*\s*$/
328 or $s =~ /^my \$d = \$cust_pkg->bill || \$time; \$d += 86400 \* \s*\d+\s*; \$cust_pkg->bill\(\$d\); \$cust_pkg_mod_flag=1; \s*\d*\.?\d*\s*$/
332 return "illegal setup: $s";
335 my $r = $self->recur;
337 $r =~ /^\s*\d*\.?\d*\s*$/
339 #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
341 or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; my \$mstart = timelocal\(0,0,0,1,\$mon,\$year\); my \$mend = timelocal\(0,0,0,1, \$mon == 11 \? 0 : \$mon\+1, \$year\+\(\$mon==11\)\); \$sdate = \$mstart; \( \$part_pkg->freq \- 1 \) \* \d*\.?\d* \/ \$part_pkg\-\>freq \+ \d*\.?\d* \/ \$part_pkg\-\>freq \* \(\$mend\-\$mnow\) \/ \(\$mend\-\$mstart\) ;\s*$/
343 or $r =~ /^my \$mnow = \$sdate; my \(\$sec,\$min,\$hour,\$mday,\$mon,\$year\) = \(localtime\(\$sdate\) \)\[0,1,2,3,4,5\]; \$sdate = timelocal\(0,0,0,1,\$mon,\$year\); \s*\d*\.?\d*\s*;\s*$/
345 or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main\->referral_cust_main_ncancelled\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
347 or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\(\$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
349 or $r =~ /^my \$error = \$cust_pkg\->cust_main\->credit\( \s*\d*\.?\d*\s* \* scalar\( grep \{ my \$pkgpart = \$_\->pkgpart; grep \{ \$_ == \$pkgpart \} \(\s*(\s*\d+,\s*)*\s*\) \} \$cust_pkg\->cust_main->referral_cust_pkg\(\s*\d+\s*\)\), "commission" \); die \$error if \$error; \s*\d*\.?\d*\s*;\s*$/
351 or $r =~ /^my \$hours = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 3600 \- \s*\d*\.?\d*\s*; \$hours = 0 if \$hours < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$hours;\s*$/
353 or $r =~ /^my \$min = \$cust_pkg\->seconds_since\(\$cust_pkg\->bill \|\| 0\) \/ 60 \- \s*\d*\.?\d*\s*; \$min = 0 if \$min < 0; \s*\d*\.?\d*\s* \+ \s*\d*\.?\d*\s* \* \$min;\s*$/
355 or $r =~ /^my \$last_bill = \$cust_pkg\->last_bill; my \$hours = \$cust_pkg\->seconds_since_sqlradacct\(\$last_bill, \$sdate \) \/ 3600 - \s*\d\.?\d*\s*; \$hours = 0 if \$hours < 0; my \$input = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctInputOctets" \) \/ 1048576; my \$output = \$cust_pkg\->attribute_since_sqlradacct\(\$last_bill, \$sdate, "AcctOutputOctets" \) \/ 1048576; my \$total = \$input \+ \$output \- \s*\d\.?\d*\s*; \$total = 0 if \$total < 0; my \$input = \$input - \s*\d\.?\d*\s*; \$input = 0 if \$input < 0; my \$output = \$output - \s*\d\.?\d*\s*; \$output = 0 if \$output < 0; \s*\d\.?\d*\s* \+ \s*\d\.?\d*\s* \* \$hours \+ \s*\d\.?\d*\s* \* \$input \+ \s*\d\.?\d*\s* \* \$output \+ \s*\d\.?\d*\s* \* \$total *;\s*$/
359 return "illegal recur: $r";
364 if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
365 my $error = $self->ut_number('freq');
366 return $error if $error;
368 $self->freq =~ /^(\d+[dw]?)$/
369 or return "Illegal or empty freq: ". $self->freq;
373 $self->ut_numbern('pkgpart')
374 || $self->ut_text('pkg')
375 || $self->ut_text('comment')
376 || $self->ut_anything('setup')
377 || $self->ut_anything('recur')
378 || $self->ut_alphan('plan')
379 || $self->ut_anything('plandata')
380 || $self->ut_enum('setuptax', [ '', 'Y' ] )
381 || $self->ut_enum('recurtax', [ '', 'Y' ] )
382 || $self->ut_textn('taxclass')
383 || $self->ut_enum('disabled', [ '', 'Y' ] )
389 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
390 definition (with non-zero quantity).
396 grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
399 =item svcpart [ SVCDB ]
401 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
402 associated with this billing item definition (see L<FS::pkg_svc>). Returns
403 false if there not a primary service definition or exactly one service
404 definition with quantity 1, or if SVCDB is specified and does not match the
405 svcdb of the service definition,
411 my $svcdb = scalar(@_) ? shift : '';
413 grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
415 @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
416 if dbdef->table('pkg_svc')->column('primary_svc');
417 @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
419 return '' if scalar(@pkg_svc) != 1;
420 $pkg_svc[0]->svcpart;
425 Returns a list of the acceptable payment types for this package. Eventually
426 this should come out of a database table and be editable, but currently has the
427 following logic instead;
429 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
430 returned, otherwise, the single item B<CARD> is returned.
432 (CHEK? LEC? Probably shouldn't accept those by default, prone to abuse)
438 #if ( $self->setup == 0 && $self->recur == 0 ) {
439 if ( $self->setup =~ /^\s*0+(\.0*)?\s*$/
440 && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
451 The delete method is unimplemented.
453 setup and recur semantics are not yet defined (and are implemented in
454 FS::cust_bill. hmm.).
458 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
459 schema.html from the base documentation.