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 - Texas tax class flag, empty or "none", "access", or "hosting"
  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     $self->ut_numbern('pkgpart')
 229       || $self->ut_text('pkg')
 230       || $self->ut_text('comment')
 231       || $self->ut_anything('setup')
 232       || $self->ut_number('freq')
 233       || $self->ut_anything('recur')
 234       || $self->ut_alphan('plan')
 235       || $self->ut_anything('plandata')
 236       || $self->ut_enum('setuptax', [ '', 'Y' ] )
 237       || $self->ut_enum('recurtax', [ '', 'Y' ] )
 238       || $self->ut_enum('texastax', [ '', 'none', 'access', 'hosting' ] )
 239       || $self->ut_enum('disabled', [ '', 'Y' ] )
 240     ;
 241 }
 242
 243 =item pkg_svc
 244
 245 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 246 definition (with non-zero quantity).
 247
 248 =cut
 249
 250 sub pkg_svc {
 251   my $self = shift;
 252   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 253 }
 254
 255 =item svcpart [ SVCDB ]
 256
 257 Returns the svcpart of a single service definition (see L<FS::part_svc>)
 258 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 259 false if there not exactly one service definition with quantity 1, or if
 260 SVCDB is specified and does not match the svcdb of the service definition,
 261
 262 =cut
 263
 264 sub svcpart {
 265   my $self = shift;
 266   my $svcdb = shift;
 267   my @pkg_svc = $self->pkg_svc;
 268   return '' if scalar(@pkg_svc) != 1
 269                || $pkg_svc[0]->quantity != 1
 270                || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb );
 271   $pkg_svc[0]->svcpart;
 272 }
 273
 274 =item payby
 275
 276 Returns a list of the acceptable payment types for this package.  Eventually
 277 this should come out of a database table and be editable, but currently has the
 278 following logic instead;
 279
 280 If the package has B<0> setup and B<0> recur, the single item B<BILL> is
 281 returned, otherwise, the single item B<CARD> is returned.
 282
 283 =cut
 284
 285 sub payby {
 286   my $self = shift;
 287   #if ( $self->setup == 0 && $self->recur == 0 ) {
 288   if (    $self->setup =~ /^\s*0+(\.0*)?\s*$/
 289        && $self->recur =~ /^\s*0+(\.0*)?\s*$/ ) {
 290     ( 'BILL' );
 291   } else {
 292     ( 'CARD' );
 293   }
 294 }
 295
 296 =back
 297
 298 =head1 VERSION
 299
 300 $Id: part_pkg.pm,v 1.12 2002-04-25 10:37:08 ivan Exp $
 301
 302 =head1 BUGS
 303
 304 The delete method is unimplemented.
 305
 306 setup and recur semantics are not yet defined (and are implemented in
 307 FS::cust_bill.  hmm.).
 308
 309 =head1 SEE ALSO
 310
 311 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 312 schema.html from the base documentation.
 313
 314 =cut
 315
 316 1;
 317