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