FS/FS/part_pkg.pm

   1 package FS::part_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearch dbh dbdef );
   6 use FS::pkg_svc;
   7 use FS::part_svc;
   8 use FS::cust_pkg;
   9 use FS::agent_type;
  10 use FS::type_pkgs;
  11 use FS::Conf;
  12
  13 @ISA = qw( FS::Record );
  14
  15 =head1 NAME
  16
  17 FS::part_pkg - Object methods for part_pkg objects
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::part_pkg;
  22
  23   $record = new FS::part_pkg \%hash
  24   $record = new FS::part_pkg { 'column' => 'value' };
  25
  26   $custom_record = $template_record->clone;
  27
  28   $error = $record->insert;
  29
  30   $error = $new_record->replace($old_record);
  31
  32   $error = $record->delete;
  33
  34   $error = $record->check;
  35
  36   @pkg_svc = $record->pkg_svc;
  37
  38   $svcnum = $record->svcpart;
  39   $svcnum = $record->svcpart( 'svc_acct' );
  40
  41 =head1 DESCRIPTION
  42
  43 An FS::part_pkg object represents a billing item definition.  FS::part_pkg
  44 inherits from FS::Record.  The following fields are currently supported:
  45
  46 =over 4
  47
  48 =item pkgpart - primary key (assigned automatically for new billing item definitions)
  49
  50 =item pkg - Text name of this billing item definition (customer-viewable)
  51
  52 =item comment - Text name of this billing item definition (non-customer-viewable)
  53
  54 =item setup - Setup fee expression
  55
  56 =item freq - Frequency of recurring fee
  57
  58 =item recur - Recurring fee expression
  59
  60 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  61
  62 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  63
  64 =item taxclass - Tax class flag
  65
  66 =item plan - Price plan
  67
  68 =item plandata - Price plan data
  69
  70 =item disabled - Disabled flag, empty or `Y'
  71
  72 =back
  73
  74 setup and recur are evaluated as Safe perl expressions.  You can use numbers
  75 just as you would normally.  More advanced semantics are not yet defined.
  76
  77 =head1 METHODS
  78
  79 =over 4
  80
  81 =item new HASHREF
  82
  83 Creates a new billing item definition.  To add the billing item definition to
  84 the database, see L<"insert">.
  85
  86 =cut
  87
  88 sub table { 'part_pkg'; }
  89
  90 =item clone
  91
  92 An alternate constructor.  Creates a new billing item definition by duplicating
  93 an existing definition.  A new pkgpart is assigned and `(CUSTOM) ' is prepended
  94 to the comment field.  To add the billing item definition to the database, see
  95 L<"insert">.
  96
  97 =cut
  98
  99 sub clone {
 100   my $self = shift;
 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 ); # ?
 108 }
 109
 110 =item insert [ , OPTION => VALUE ... ]
 111
 112 Adds this billing item definition to the database.  If there is an error,
 113 returns the error, otherwise returns false.
 114
 115 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
 116 I<custnum_ref>.
 117
 118 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 119 values, appropriate FS::pkg_svc records will be inserted.
 120
 121 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 122 FS::pkg_svc record will be updated.
 123
 124 If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg
 125 record itself), the object will be updated to point to this package definition.
 126
 127 In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference,
 128 the scalar will be updated with the custnum value from the cust_pkg record.
 129
 130 =cut
 131
 132 sub insert {
 133   my $self = shift;
 134   my %options = @_;
 135   warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
 136
 137   local $SIG{HUP} = 'IGNORE';
 138   local $SIG{INT} = 'IGNORE';
 139   local $SIG{QUIT} = 'IGNORE';
 140   local $SIG{TERM} = 'IGNORE';
 141   local $SIG{TSTP} = 'IGNORE';
 142   local $SIG{PIPE} = 'IGNORE';
 143
 144   my $oldAutoCommit = $FS::UID::AutoCommit;
 145   local $FS::UID::AutoCommit = 0;
 146   my $dbh = dbh;
 147
 148   my $error = $self->SUPER::insert;
 149   if ( $error ) {
 150     $dbh->rollback if $oldAutoCommit;
 151     return $error;
 152   }
 153
 154   my $conf = new FS::Conf;
 155
 156   if ( $conf->exists('agent_defaultpkg') ) {
 157     foreach my $agent_type ( qsearch('agent_type', {} ) ) {
 158       my $type_pkgs = new FS::type_pkgs({
 159         'typenum' => $agent_type->typenum,
 160         'pkgpart' => $self->pkgpart,
 161       });
 162       my $error = $type_pkgs->insert;
 163       if ( $error ) {
 164         $dbh->rollback if $oldAutoCommit;
 165         return $error;
 166       }
 167     }
 168   }
 169
 170   warn "  inserting pkg_svc records" if $DEBUG;
 171   my $pkg_svc = $options{'pkg_svc'} || {};
 172   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 173     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 174     my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
 175
 176     my $pkg_svc = new FS::pkg_svc( {
 177       'pkgpart'     => $self->pkgpart,
 178       'svcpart'     => $part_svc->svcpart,
 179       'quantity'    => $quantity,
 180       'primary_svc' => $primary_svc,
 181     } );
 182     my $error = $pkg_svc->insert;
 183     if ( $error ) {
 184       $dbh->rollback if $oldAutoCommit;
 185       return $error;
 186     }
 187   }
 188
 189   if ( $options{'cust_pkg'} ) {
 190     warn "  updating cust_pkg record " if $DEBUG;
 191     my $old_cust_pkg =
 192       ref($options{'cust_pkg'})
 193         ? $options{'cust_pkg'}
 194         : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } );
 195     ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum
 196       if $options{'custnum_ref'};
 197     my %hash = $old_cust_pkg->hash;
 198     $hash{'pkgpart'} = $self->pkgpart,
 199     my $new_cust_pkg = new FS::cust_pkg \%hash;
 200     local($FS::cust_pkg::disable_agentcheck) = 1;
 201     my $error = $new_cust_pkg->replace($old_cust_pkg);
 202     if ( $error ) {
 203       $dbh->rollback if $oldAutoCommit;
 204       return "Error modifying cust_pkg record: $error";
 205     }
 206   }
 207
 208   warn "  commiting transaction" if $DEBUG;
 209   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 210
 211   '';
 212 }
 213
 214 =item delete
 215
 216 Currently unimplemented.
 217
 218 =cut
 219
 220 sub delete {
 221   return "Can't (yet?) delete package definitions.";
 222 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 223 }
 224
 225 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 226
 227 Replaces OLD_RECORD with this one in the database.  If there is an error,
 228 returns the error, otherwise returns false.
 229
 230 Currently available options are: I<pkg_svc> and I<primary_svc>
 231
 232 If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as
 233 values, the appropriate FS::pkg_svc records will be replace.
 234
 235 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 236 FS::pkg_svc record will be updated.
 237
 238 =cut
 239
 240 sub replace {
 241   my( $new, $old ) = ( shift, shift );
 242   my %options = @_;
 243   warn "FS::part_pkg::replace called on $new to replace $old ".
 244        "with options %options"
 245     if $DEBUG;
 246
 247   local $SIG{HUP} = 'IGNORE';
 248   local $SIG{INT} = 'IGNORE';
 249   local $SIG{QUIT} = 'IGNORE';
 250   local $SIG{TERM} = 'IGNORE';
 251   local $SIG{TSTP} = 'IGNORE';
 252   local $SIG{PIPE} = 'IGNORE';
 253
 254   my $oldAutoCommit = $FS::UID::AutoCommit;
 255   local $FS::UID::AutoCommit = 0;
 256   my $dbh = dbh;
 257
 258   warn "  replacing part_pkg record" if $DEBUG;
 259   my $error = $new->SUPER::replace($old);
 260   if ( $error ) {
 261     $dbh->rollback if $oldAutoCommit;
 262     return $error;
 263   }
 264
 265   warn "  replacing pkg_svc records" if $DEBUG;
 266   my $pkg_svc = $options{'pkg_svc'} || {};
 267   foreach my $part_svc ( qsearch('part_svc', {} ) ) {
 268     my $quantity = $pkg_svc->{$part_svc->svcpart} || 0;
 269     my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : '';
 270
 271     my $old_pkg_svc = qsearchs('pkg_svc', {
 272       'pkgpart' => $old->pkgpart,
 273       'svcpart' => $part_svc->svcpart,
 274     } );
 275     my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0;
 276     my $old_primary_svc =
 277       ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') )
 278         ? $old_pkg_svc->primary_svc
 279         : '';
 280     next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
 281
 282     my $new_pkg_svc = new FS::pkg_svc( {
 283       'pkgpart'     => $new->pkgpart,
 284       'svcpart'     => $part_svc->svcpart,
 285       'quantity'    => $quantity,
 286       'primary_svc' => $primary_svc,
 287     } );
 288     my $error = $old_pkg_svc
 289                   ? $new_pkg_svc->replace($old_pkg_svc)
 290                   : $new_pkg_svc->insert;
 291     if ( $error ) {
 292       $dbh->rollback if $oldAutoCommit;
 293       return $error;
 294     }
 295   }
 296
 297   warn "  commiting transaction" if $DEBUG;
 298   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 299   '';
 300 }
 301
 302 =item check
 303
 304 Checks all fields to make sure this is a valid billing item definition.  If
 305 there is an error, returns the error, otherwise returns false.  Called by the
 306 insert and replace methods.
 307
 308 =cut
 309
 310 sub check {
 311   my $self = shift;
 312
 313   for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 314
 315   my $conf = new FS::Conf;
 316   if ( $conf->exists('safe-part_pkg') ) {
 317
 318     my $error = $self->ut_anything('setup')
 319                 || $self->ut_anything('recur');
 320     return $error if $error;
 321
 322     my $s = $self->setup;
 323
 324     $s =~ /^\s*\d*\.?\d*\s*$/
 325
 326       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*$/
 327
 328       or do {
 329         #log!
 330         return "illegal setup: $s";
 331       };
 332
 333     my $r = $self->recur;
 334
 335     $r =~ /^\s*\d*\.?\d*\s*$/
 336
 337       #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
 338
 339       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*$/
 340
 341       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*$/
 342
 343       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*$/
 344
 345       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*$/
 346
 347       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*$/
 348
 349       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*$/
 350
 351       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*$/
 352
 353       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*$/
 354
 355       or do {
 356         #log!
 357         return "illegal recur: $r";
 358       };
 359
 360   }
 361
 362   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 363     my $error = $self->ut_number('freq');
 364     return $error if $error;
 365   } else {
 366     $self->freq =~ /^(\d+[dw]?)$/
 367       or return "Illegal or empty freq: ". $self->freq;
 368     $self->freq($1);
 369   }
 370
 371     $self->ut_numbern('pkgpart')
 372       || $self->ut_text('pkg')
 373       || $self->ut_text('comment')
 374       || $self->ut_anything('setup')
 375       || $self->ut_anything('recur')
 376       || $self->ut_alphan('plan')
 377       || $self->ut_anything('plandata')
 378       || $self->ut_enum('setuptax', [ '', 'Y' ] )
 379       || $self->ut_enum('recurtax', [ '', 'Y' ] )
 380       || $self->ut_textn('taxclass')
 381       || $self->ut_enum('disabled', [ '', 'Y' ] )
 382     ;
 383 }
 384
 385 =item pkg_svc
 386
 387 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 388 definition (with non-zero quantity).
 389
 390 =cut
 391
 392 sub pkg_svc {
 393   my $self = shift;
 394   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 395 }
 396
 397 =item svcpart [ SVCDB ]
 398
 399 Returns the svcpart of the primary service definition (see L<FS::part_svc>)
 400 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 401 false if there not a primary service definition or exactly one service
 402 definition with quantity 1, or if SVCDB is specified and does not match the
 403 svcdb of the service definition,
 404
 405 =cut
 406
 407 sub svcpart {
 408   my $self = shift;
 409   my $svcdb = scalar(@_) ? shift : '';
 410   my @svcdb_pkg_svc =
 411     grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
 412   my @pkg_svc = ();
 413   @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
 414     if dbdef->table('pkg_svc')->column('primary_svc');
 415   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 416     unless @pkg_svc;
 417   return '' if scalar(@pkg_svc) != 1;
 418   $pkg_svc[0]->svcpart;
 419 }
 420
 421 =item payby
 422
 423 Returns a list of the acceptable payment types for this package.  Eventually
 424 this should come out of a database table and be editable, but currently has the
 425 following logic instead;
 426
 427 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
 428 returned, otherwise, the single item B<CARD> is returned.
 429
 430 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 431
 432 =cut
 433
 434 sub payby {
 435   my $self = shift;
 436   #if ( $self->setup == 0 && $self->recur == 0 ) {
 437   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 438        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 439     ( 'BILL' );
 440   } else {
 441     ( 'CARD' );
 442   }
 443 }
 444
 445 =back
 446
 447 =head1 BUGS
 448
 449 The delete method is unimplemented.
 450
 451 setup and recur semantics are not yet defined (and are implemented in
 452 FS::cust_bill.  hmm.).
 453
 454 =head1 SEE ALSO
 455
 456 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 457 schema.html from the base documentation.
 458
 459 =cut
 460
 461 1;
 462