FS/FS/part_pkg.pm

   1 package FS::part_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   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 $DEBUG = 0;
  16
  17 =head1 NAME
  18
  19 FS::part_pkg - Object methods for part_pkg objects
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::part_pkg;
  24
  25   $record = new FS::part_pkg \%hash
  26   $record = new FS::part_pkg { 'column' => 'value' };
  27
  28   $custom_record = $template_record->clone;
  29
  30   $error = $record->insert;
  31
  32   $error = $new_record->replace($old_record);
  33
  34   $error = $record->delete;
  35
  36   $error = $record->check;
  37
  38   @pkg_svc = $record->pkg_svc;
  39
  40   $svcnum = $record->svcpart;
  41   $svcnum = $record->svcpart( 'svc_acct' );
  42
  43 =head1 DESCRIPTION
  44
  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:
  47
  48 =over 4
  49
  50 =item pkgpart - primary key (assigned automatically for new billing item definitions)
  51
  52 =item pkg - Text name of this billing item definition (customer-viewable)
  53
  54 =item comment - Text name of this billing item definition (non-customer-viewable)
  55
  56 =item setup - Setup fee expression
  57
  58 =item freq - Frequency of recurring fee
  59
  60 =item recur - Recurring fee expression
  61
  62 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  63
  64 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  65
  66 =item taxclass - Tax class flag
  67
  68 =item plan - Price plan
  69
  70 =item plandata - Price plan data
  71
  72 =item disabled - Disabled flag, empty or `Y'
  73
  74 =back
  75
  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.
  78
  79 =head1 METHODS
  80
  81 =over 4
  82
  83 =item new HASHREF
  84
  85 Creates a new billing item definition.  To add the billing item definition to
  86 the database, see L<"insert">.
  87
  88 =cut
  89
  90 sub table { 'part_pkg'; }
  91
  92 =item clone
  93
  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
  97 L<"insert">.
  98
  99 =cut
 100
 101 sub clone {
 102   my $self = shift;
 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 ); # ?
 110 }
 111
 112 =item insert [ , OPTION => VALUE ... ]
 113
 114 Adds this billing item definition to the database.  If there is an error,
 115 returns the error, otherwise returns false.
 116
 117 Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and
 118 I<custnum_ref>.
 119
 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.
 122
 123 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 124 FS::pkg_svc record will be updated.
 125
 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.
 128
 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.
 131
 132 =cut
 133
 134 sub insert {
 135   my $self = shift;
 136   my %options = @_;
 137   warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG;
 138
 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';
 145
 146   my $oldAutoCommit = $FS::UID::AutoCommit;
 147   local $FS::UID::AutoCommit = 0;
 148   my $dbh = dbh;
 149
 150   my $error = $self->SUPER::insert;
 151   if ( $error ) {
 152     $dbh->rollback if $oldAutoCommit;
 153     return $error;
 154   }
 155
 156   my $conf = new FS::Conf;
 157
 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,
 163       });
 164       my $error = $type_pkgs->insert;
 165       if ( $error ) {
 166         $dbh->rollback if $oldAutoCommit;
 167         return $error;
 168       }
 169     }
 170   }
 171
 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' : '';
 177
 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,
 183     } );
 184     my $error = $pkg_svc->insert;
 185     if ( $error ) {
 186       $dbh->rollback if $oldAutoCommit;
 187       return $error;
 188     }
 189   }
 190
 191   if ( $options{'cust_pkg'} ) {
 192     warn "  updating cust_pkg record " if $DEBUG;
 193     my $old_cust_pkg =
 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);
 204     if ( $error ) {
 205       $dbh->rollback if $oldAutoCommit;
 206       return "Error modifying cust_pkg record: $error";
 207     }
 208   }
 209
 210   warn "  commiting transaction" if $DEBUG;
 211   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 212
 213   '';
 214 }
 215
 216 =item delete
 217
 218 Currently unimplemented.
 219
 220 =cut
 221
 222 sub delete {
 223   return "Can't (yet?) delete package definitions.";
 224 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 225 }
 226
 227 =item replace OLD_RECORD [ , OPTION => VALUE ... ]
 228
 229 Replaces OLD_RECORD with this one in the database.  If there is an error,
 230 returns the error, otherwise returns false.
 231
 232 Currently available options are: I<pkg_svc> and I<primary_svc>
 233
 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.
 236
 237 If I<primary_svc> is set to the svcpart of the primary service, the appropriate
 238 FS::pkg_svc record will be updated.
 239
 240 =cut
 241
 242 sub replace {
 243   my( $new, $old ) = ( shift, shift );
 244   my %options = @_;
 245   warn "FS::part_pkg::replace called on $new to replace $old ".
 246        "with options %options"
 247     if $DEBUG;
 248
 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';
 255
 256   my $oldAutoCommit = $FS::UID::AutoCommit;
 257   local $FS::UID::AutoCommit = 0;
 258   my $dbh = dbh;
 259
 260   warn "  replacing part_pkg record" if $DEBUG;
 261   my $error = $new->SUPER::replace($old);
 262   if ( $error ) {
 263     $dbh->rollback if $oldAutoCommit;
 264     return $error;
 265   }
 266
 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' : '';
 272
 273     my $old_pkg_svc = qsearchs('pkg_svc', {
 274       'pkgpart' => $old->pkgpart,
 275       'svcpart' => $part_svc->svcpart,
 276     } );
 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
 281         : '';
 282     next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc;
 283
 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,
 289     } );
 290     my $error = $old_pkg_svc
 291                   ? $new_pkg_svc->replace($old_pkg_svc)
 292                   : $new_pkg_svc->insert;
 293     if ( $error ) {
 294       $dbh->rollback if $oldAutoCommit;
 295       return $error;
 296     }
 297   }
 298
 299   warn "  commiting transaction" if $DEBUG;
 300   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 301   '';
 302 }
 303
 304 =item check
 305
 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.
 309
 310 =cut
 311
 312 sub check {
 313   my $self = shift;
 314
 315   for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 316
 317   my $conf = new FS::Conf;
 318   if ( $conf->exists('safe-part_pkg') ) {
 319
 320     my $error = $self->ut_anything('setup')
 321                 || $self->ut_anything('recur');
 322     return $error if $error;
 323
 324     my $s = $self->setup;
 325
 326     $s =~ /^\s*\d*\.?\d*\s*$/
 327
 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*$/
 329
 330       or do {
 331         #log!
 332         return "illegal setup: $s";
 333       };
 334
 335     my $r = $self->recur;
 336
 337     $r =~ /^\s*\d*\.?\d*\s*$/
 338
 339       #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
 340
 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*$/
 342
 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*$/
 344
 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*$/
 346
 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*$/
 348
 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*$/
 350
 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*$/
 352
 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*$/
 354
 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*$/
 356
 357       or do {
 358         #log!
 359         return "illegal recur: $r";
 360       };
 361
 362   }
 363
 364   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 365     my $error = $self->ut_number('freq');
 366     return $error if $error;
 367   } else {
 368     $self->freq =~ /^(\d+[dw]?)$/
 369       or return "Illegal or empty freq: ". $self->freq;
 370     $self->freq($1);
 371   }
 372
 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' ] )
 384     ;
 385 }
 386
 387 =item pkg_svc
 388
 389 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 390 definition (with non-zero quantity).
 391
 392 =cut
 393
 394 sub pkg_svc {
 395   my $self = shift;
 396   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 397 }
 398
 399 =item svcpart [ SVCDB ]
 400
 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,
 406
 407 =cut
 408
 409 sub svcpart {
 410   my $self = shift;
 411   my $svcdb = scalar(@_) ? shift : '';
 412   my @svcdb_pkg_svc =
 413     grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
 414   my @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
 418     unless @pkg_svc;
 419   return '' if scalar(@pkg_svc) != 1;
 420   $pkg_svc[0]->svcpart;
 421 }
 422
 423 =item payby
 424
 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;
 428
 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.
 431
 432 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 433
 434 =cut
 435
 436 sub payby {
 437   my $self = shift;
 438   #if ( $self->setup == 0 && $self->recur == 0 ) {
 439   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 440        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 441     ( 'BILL' );
 442   } else {
 443     ( 'CARD' );
 444   }
 445 }
 446
 447 =back
 448
 449 =head1 BUGS
 450
 451 The delete method is unimplemented.
 452
 453 setup and recur semantics are not yet defined (and are implemented in
 454 FS::cust_bill.  hmm.).
 455
 456 =head1 SEE ALSO
 457
 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.
 460
 461 =cut
 462
 463 1;
 464