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 qsearchs 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   my $conf = new FS::Conf;
 184   if ( $conf->exists('safe-part_pkg') ) {
 185
 186     my $error = $self->ut_anything('setup')
 187                 || $self->ut_anything('recur');
 188     return $error if $error;
 189
 190     my $s = $self->setup;
 191
 192     $s =~ /^\s*\d*\.?\d*\s*$/
 193
 194       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*$/
 195
 196       or do {
 197         #log!
 198         return "illegal setup: $s";
 199       };
 200
 201     my $r = $self->recur;
 202
 203     $r =~ /^\s*\d*\.?\d*\s*$/
 204
 205       #or $r =~ /^\$sdate += 86400 \* \s*\d+\s*; \s*\d*\.?\d*\s*$/
 206
 207       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*$/
 208
 209       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*$/
 210
 211       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*$/
 212
 213       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*$/
 214
 215       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*$/
 216
 217       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*$/
 218
 219       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*$/
 220
 221       or do {
 222         #log!
 223         return "illegal recur: $r";
 224       };
 225
 226   }
 227
 228   if ($self->def_svcpart and my @pkg_svc = $self->pkg_svc) {
 229     unless (grep { $_->svcpart == $self->def_svcpart } @pkg_svc) {
 230       return "no svcparts for this package match def_svcpart ".$self->def_svcpart;
 231     }
 232   }
 233
 234     $self->ut_numbern('pkgpart')
 235       || $self->ut_text('pkg')
 236       || $self->ut_text('comment')
 237       || $self->ut_anything('setup')
 238       || $self->ut_number('freq')
 239       || $self->ut_anything('recur')
 240       || $self->ut_alphan('plan')
 241       || $self->ut_anything('plandata')
 242       || $self->ut_enum('setuptax', [ '', 'Y' ] )
 243       || $self->ut_enum('recurtax', [ '', 'Y' ] )
 244       || $self->ut_textn('taxclass')
 245       || $self->ut_enum('disabled', [ '', 'Y' ] )
 246     ;
 247 }
 248
 249 =item pkg_svc
 250
 251 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 252 definition (with non-zero quantity).
 253
 254 =cut
 255
 256 sub pkg_svc {
 257   my $self = shift;
 258   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 259 }
 260
 261 =item svcpart [ SVCDB ]
 262
 263 Returns the svcpart of a single service definition (see L<FS::part_svc>)
 264 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 265 false if there not exactly one service definition with quantity 1, or if
 266 SVCDB is specified and does not match the svcdb of the service definition,
 267
 268 If the part_pkg has a nonzero def_svcpart, it takes precedence, even if it has
 269 quantity > 1 and/or there are other service definitions, UNLESS SVCDB is specified
 270 and doesn't match the svcdb of the def_svcpart.
 271
 272 =cut
 273
 274 sub svcpart {
 275   my $self = shift;
 276   my $svcdb = shift;
 277
 278   if ($self->def_svcpart) {
 279     if ((not $svcdb) or qsearchs('part_svc', { svcpart => $self->def_svcpart,
 280                                                svcdb   => $svcdb })) {
 281       return $self->def_svcpart;
 282     }
 283   }
 284
 285   my @pkg_svc = $self->pkg_svc;
 286   return '' if scalar(@pkg_svc) != 1
 287                || $pkg_svc[0]->quantity != 1
 288                || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb );
 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 =cut
 302
 303 sub payby {
 304   my $self = shift;
 305   #if ( $self->setup == 0 && $self->recur == 0 ) {
 306   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 307        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 308     ( 'BILL' );
 309   } else {
 310     ( 'CARD' );
 311   }
 312 }
 313
 314 =back
 315
 316 =head1 VERSION
 317
 318 $Id: part_pkg.pm,v 1.15 2002-06-08 07:48:36 khoff Exp $
 319
 320 =head1 BUGS
 321
 322 The delete method is unimplemented.
 323
 324 setup and recur semantics are not yet defined (and are implemented in
 325 FS::cust_bill.  hmm.).
 326
 327 =head1 SEE ALSO
 328
 329 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 330 schema.html from the base documentation.
 331
 332 =cut
 333
 334 1;
 335