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::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 the primary 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 a primary service definition or exactly one service
 272 definition with quantity 1, or if SVCDB is specified and does not match the
 273 svcdb of the service definition,
 274
 275 =cut
 276
 277 sub svcpart {
 278   my $self = shift;
 279   my $svcdb = scalar(@_) ? shift : '';
 280   my @svcdb_pkg_svc =
 281     grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc;
 282   my @pkg_svc = ();
 283   @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc
 284     if dbdef->table('pkg_svc')->column('primary_svc');
 285   @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc
 286     unless @pkg_svc;
 287   return '' if scalar(@pkg_svc) != 1;
 288   $pkg_svc[0]->svcpart;
 289 }
 290
 291 =item payby
 292
 293 Returns a list of the acceptable payment types for this package.  Eventually
 294 this should come out of a database table and be editable, but currently has the
 295 following logic instead;
 296
 297 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
 298 returned, otherwise, the single item B<CARD> is returned.
 299
 300 (CHEK?  LEC?  Probably shouldn't accept those by default, prone to abuse)
 301
 302 =cut
 303
 304 sub payby {
 305   my $self = shift;
 306   #if ( $self->setup == 0 && $self->recur == 0 ) {
 307   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 308        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 309     ( 'BILL' );
 310   } else {
 311     ( 'CARD' );
 312   }
 313 }
 314
 315 =back
 316
 317 =head1 BUGS
 318
 319 The delete method is unimplemented.
 320
 321 setup and recur semantics are not yet defined (and are implemented in
 322 FS::cust_bill.  hmm.).
 323
 324 =head1 SEE ALSO
 325
 326 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 327 schema.html from the base documentation.
 328
 329 =cut
 330
 331 1;
 332