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 );
   6 use FS::pkg_svc;
   7 use FS::agent_type;
   8 use FS::type_pkgs;
   9 use FS::Conf;
  10
  11 @ISA = qw( FS::Record );
  12
  13 =head1 NAME
  14
  15 FS::part_pkg - Object methods for part_pkg objects
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::part_pkg;
  20
  21   $record = new FS::part_pkg \%hash
  22   $record = new FS::part_pkg { 'column' => 'value' };
  23
  24   $custom_record = $template_record->clone;
  25
  26   $error = $record->insert;
  27
  28   $error = $new_record->replace($old_record);
  29
  30   $error = $record->delete;
  31
  32   $error = $record->check;
  33
  34   @pkg_svc = $record->pkg_svc;
  35
  36   $svcnum = $record->svcpart;
  37   $svcnum = $record->svcpart( 'svc_acct' );
  38
  39 =head1 DESCRIPTION
  40
  41 An FS::part_pkg object represents a billing item definition.  FS::part_pkg
  42 inherits from FS::Record.  The following fields are currently supported:
  43
  44 =over 4
  45
  46 =item pkgpart - primary key (assigned automatically for new billing item definitions)
  47
  48 =item pkg - Text name of this billing item definition (customer-viewable)
  49
  50 =item comment - Text name of this billing item definition (non-customer-viewable)
  51
  52 =item setup - Setup fee expression
  53
  54 =item freq - Frequency of recurring fee
  55
  56 =item recur - Recurring fee expression
  57
  58 =item setuptax - Setup fee tax exempt flag, empty or `Y'
  59
  60 =item recurtax - Recurring fee tax exempt flag, empty or `Y'
  61
  62 =item taxclass - Tax class flag
  63
  64 =item plan - Price plan
  65
  66 =item plandata - Price plan data
  67
  68 =item disabled - Disabled flag, empty or `Y'
  69
  70 =back
  71
  72 setup and recur are evaluated as Safe perl expressions.  You can use numbers
  73 just as you would normally.  More advanced semantics are not yet defined.
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item new HASHREF
  80
  81 Creates a new billing item definition.  To add the billing item definition to
  82 the database, see L<"insert">.
  83
  84 =cut
  85
  86 sub table { 'part_pkg'; }
  87
  88 =item clone
  89
  90 An alternate constructor.  Creates a new billing item definition by duplicating
  91 an existing definition.  A new pkgpart is assigned and `(CUSTOM) ' is prepended
  92 to the comment field.  To add the billing item definition to the database, see
  93 L<"insert">.
  94
  95 =cut
  96
  97 sub clone {
  98   my $self = shift;
  99   my $class = ref($self);
 100   my %hash = $self->hash;
 101   $hash{'pkgpart'} = '';
 102   $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
 103     unless $hash{'comment'} =~ /^\(CUSTOM\) /;
 104   #new FS::part_pkg ( \%hash ); # ?
 105   new $class ( \%hash ); # ?
 106 }
 107
 108 =item insert
 109
 110 Adds this billing item definition to the database.  If there is an error,
 111 returns the error, otherwise returns false.
 112
 113 =cut
 114
 115 sub insert {
 116   my $self = shift;
 117
 118   local $SIG{HUP} = 'IGNORE';
 119   local $SIG{INT} = 'IGNORE';
 120   local $SIG{QUIT} = 'IGNORE';
 121   local $SIG{TERM} = 'IGNORE';
 122   local $SIG{TSTP} = 'IGNORE';
 123   local $SIG{PIPE} = 'IGNORE';
 124
 125   my $oldAutoCommit = $FS::UID::AutoCommit;
 126   local $FS::UID::AutoCommit = 0;
 127   my $dbh = dbh;
 128
 129   my $error = $self->SUPER::insert;
 130   if ( $error ) {
 131     $dbh->rollback if $oldAutoCommit;
 132     return $error;
 133   }
 134
 135   my $conf = new FS::Conf;
 136
 137   if ( $conf->exists('agent_defaultpkg') ) {
 138     foreach my $agent_type ( qsearch('agent_type', {} ) ) {
 139       my $type_pkgs = new FS::type_pkgs({
 140         'typenum' => $agent_type->typenum,
 141         'pkgpart' => $self->pkgpart,
 142       });
 143       my $error = $type_pkgs->insert;
 144       if ( $error ) {
 145         $dbh->rollback if $oldAutoCommit;
 146         return $error;
 147       }
 148     }
 149   }
 150
 151   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 152
 153   '';
 154 }
 155
 156 =item delete
 157
 158 Currently unimplemented.
 159
 160 =cut
 161
 162 sub delete {
 163   return "Can't (yet?) delete package definitions.";
 164 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 165 }
 166
 167 =item replace OLD_RECORD
 168
 169 Replaces OLD_RECORD with this one in the database.  If there is an error,
 170 returns the error, otherwise returns false.
 171
 172 =item check
 173
 174 Checks all fields to make sure this is a valid billing item definition.  If
 175 there is an error, returns the error, otherwise returns false.  Called by the
 176 insert and replace methods.
 177
 178 =cut
 179
 180 sub check {
 181   my $self = shift;
 182
 183   for (qw(setup recur)) { $self->set($_=>0) if $self->get($_) =~ /^\s*$/; }
 184
 185   my $conf = new FS::Conf;
 186   if ( $conf->exists('safe-part_pkg') ) {
 187
 188     my $error = $self->ut_anything('setup')
 189                 || $self->ut_anything('recur');
 190     return $error if $error;
 191
 192     my $s = $self->setup;
 193
 194     $s =~ /^\s*\d*\.?\d*\s*$/
 195
 196       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*$/
 197
 198       or do {
 199         #log!
 200         return "illegal setup: $s";
 201       };
 202
 203     my $r = $self->recur;
 204
 205     $r =~ /^\s*\d*\.?\d*\s*$/
 206
 207       #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
 208
 209       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*$/
 210
 211       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*$/
 212
 213       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*$/
 214
 215       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*$/
 216
 217       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*$/
 218
 219       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*$/
 220
 221       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*$/
 222
 223       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*$/
 224
 225       or do {
 226         #log!
 227         return "illegal recur: $r";
 228       };
 229
 230   }
 231
 232   if ( $self->dbdef_table->column('freq')->type =~ /(int)/i ) {
 233     my $error = $self->ut_number('freq');
 234     return $error if $error;
 235   } else {
 236     $self->freq =~ /^(\d+[dw]?)$/
 237       or return "Illegal or empty freq: ". $self->freq;
 238     $self->freq($1);
 239   }
 240
 241     $self->ut_numbern('pkgpart')
 242       || $self->ut_text('pkg')
 243       || $self->ut_text('comment')
 244       || $self->ut_anything('setup')
 245       || $self->ut_anything('recur')
 246       || $self->ut_alphan('plan')
 247       || $self->ut_anything('plandata')
 248       || $self->ut_enum('setuptax', [ '', 'Y' ] )
 249       || $self->ut_enum('recurtax', [ '', 'Y' ] )
 250       || $self->ut_textn('taxclass')
 251       || $self->ut_enum('disabled', [ '', 'Y' ] )
 252     ;
 253 }
 254
 255 =item pkg_svc
 256
 257 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 258 definition (with non-zero quantity).
 259
 260 =cut
 261
 262 sub pkg_svc {
 263   my $self = shift;
 264   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 265 }
 266
 267 =item svcpart [ SVCDB ]
 268
 269 Returns the svcpart of a single service definition (see L<FS::part_svc>)
 270 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 271 false if there not exactly one service definition with quantity 1, or if
 272 SVCDB is specified and does not match the svcdb of the service definition,
 273
 274 =cut
 275
 276 sub svcpart {
 277   my $self = shift;
 278   my $svcdb = scalar(@_) ? shift : '';
 279   my @pkg_svc = grep {
 280     $_->quantity == 1
 281     && ( $svcdb eq $_->part_svc->svcdb || !$svcdb )
 282   } $self->pkg_svc;
 283   return '' if scalar(@pkg_svc) != 1;
 284   $pkg_svc[0]->svcpart;
 285 }
 286
 287 =item payby
 288
 289 Returns a list of the acceptable payment types for this package.  Eventually
 290 this should come out of a database table and be editable, but currently has the
 291 following logic instead;
 292
 293 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
 294 returned, otherwise, the single item B<CARD> is returned.
 295
 296 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 297
 298 =cut
 299
 300 sub payby {
 301   my $self = shift;
 302   #if ( $self->setup == 0 && $self->recur == 0 ) {
 303   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 304        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 305     ( 'BILL' );
 306   } else {
 307     ( 'CARD' );
 308   }
 309 }
 310
 311 =back
 312
 313 =head1 BUGS
 314
 315 The delete method is unimplemented.
 316
 317 setup and recur semantics are not yet defined (and are implemented in
 318 FS::cust_bill.  hmm.).
 319
 320 =head1 SEE ALSO
 321
 322 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 323 schema.html from the base documentation.
 324
 325 =cut
 326
 327 1;
 328