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 plan - Price plan
  63
  64 =item plandata - Price plan data
  65
  66 =item disabled - Disabled flag, empty or `Y'
  67
  68 =back
  69
  70 setup and recur are evaluated as Safe perl expressions.  You can use numbers
  71 just as you would normally.  More advanced semantics are not yet defined.
  72
  73 =head1 METHODS
  74
  75 =over 4
  76
  77 =item new HASHREF
  78
  79 Creates a new billing item definition.  To add the billing item definition to
  80 the database, see L<"insert">.
  81
  82 =cut
  83
  84 sub table { 'part_pkg'; }
  85
  86 =item clone
  87
  88 An alternate constructor.  Creates a new billing item definition by duplicating
  89 an existing definition.  A new pkgpart is assigned and `(CUSTOM) ' is prepended
  90 to the comment field.  To add the billing item definition to the database, see
  91 L<"insert">.
  92
  93 =cut
  94
  95 sub clone {
  96   my $self = shift;
  97   my $class = ref($self);
  98   my %hash = $self->hash;
  99   $hash{'pkgpart'} = '';
 100   $hash{'comment'} = "(CUSTOM) ". $hash{'comment'}
 101     unless $hash{'comment'} =~ /^\(CUSTOM\) /;
 102   #new FS::part_pkg ( \%hash ); # ?
 103   new $class ( \%hash ); # ?
 104 }
 105
 106 =item insert
 107
 108 Adds this billing item definition to the database.  If there is an error,
 109 returns the error, otherwise returns false.
 110
 111 =cut
 112
 113 sub insert {
 114   my $self = shift;
 115
 116   local $SIG{HUP} = 'IGNORE';
 117   local $SIG{INT} = 'IGNORE';
 118   local $SIG{QUIT} = 'IGNORE';
 119   local $SIG{TERM} = 'IGNORE';
 120   local $SIG{TSTP} = 'IGNORE';
 121   local $SIG{PIPE} = 'IGNORE';
 122
 123   my $oldAutoCommit = $FS::UID::AutoCommit;
 124   local $FS::UID::AutoCommit = 0;
 125   my $dbh = dbh;
 126
 127   my $error = $self->SUPER::insert;
 128   if ( $error ) {
 129     $dbh->rollback if $oldAutoCommit;
 130     return $error;
 131   }
 132
 133   my $conf = new FS::Conf;
 134
 135   if ( $conf->exists('agent_defaultpkg') ) {
 136     foreach my $agent_type ( qsearch('agent_type', {} ) ) {
 137       my $type_pkgs = new FS::type_pkgs({
 138         'typenum' => $agent_type->typenum,
 139         'pkgpart' => $self->pkgpart,
 140       });
 141       my $error = $type_pkgs->insert;
 142       if ( $error ) {
 143         $dbh->rollback if $oldAutoCommit;
 144         return $error;
 145       }
 146     }
 147   }
 148
 149   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 150
 151   '';
 152 }
 153
 154 =item delete
 155
 156 Currently unimplemented.
 157
 158 =cut
 159
 160 sub delete {
 161   return "Can't (yet?) delete package definitions.";
 162 # check & make sure the pkgpart isn't in cust_pkg or type_pkgs?
 163 }
 164
 165 =item replace OLD_RECORD
 166
 167 Replaces OLD_RECORD with this one in the database.  If there is an error,
 168 returns the error, otherwise returns false.
 169
 170 =item check
 171
 172 Checks all fields to make sure this is a valid billing item definition.  If
 173 there is an error, returns the error, otherwise returns false.  Called by the
 174 insert and replace methods.
 175
 176 =cut
 177
 178 sub check {
 179   my $self = shift;
 180
 181   my $conf = new FS::Conf;
 182   if ( $conf->exists('safe-part_pkg') ) {
 183
 184     my $error = $self->ut_anything('setup')
 185                 || $self->ut_anything('recur');
 186     return $error if $error;
 187
 188     my $s = $self->setup;
 189
 190     $s =~ /^\s*\d*\.?\d*\s*$/ or do {
 191       #log!
 192       return "illegal setup: $s";
 193     };
 194
 195     my $r = $self->recur;
 196
 197     $r =~ /^\s*\d*\.?\d*\s*$/
 198
 199       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*$/
 200
 201       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*$/
 202
 203       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*$/
 204
 205       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*$/
 206
 207       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*$/
 208
 209       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*$/
 210
 211       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*$/
 212
 213       or do {
 214         #log!
 215         return "illegal recur: $r";
 216       };
 217
 218   }
 219
 220     $self->ut_numbern('pkgpart')
 221       || $self->ut_text('pkg')
 222       || $self->ut_text('comment')
 223       || $self->ut_anything('setup')
 224       || $self->ut_number('freq')
 225       || $self->ut_anything('recur')
 226       || $self->ut_alphan('plan')
 227       || $self->ut_anything('plandata')
 228       || $self->ut_enum('setuptax', [ '', 'Y' ] )
 229       || $self->ut_enum('recurtax', [ '', 'Y' ] )
 230       || $self->ut_enum('disabled', [ '', 'Y' ] )
 231     ;
 232 }
 233
 234 =item pkg_svc
 235
 236 Returns all FS::pkg_svc objects (see L<FS::pkg_svc>) for this package
 237 definition (with non-zero quantity).
 238
 239 =cut
 240
 241 sub pkg_svc {
 242   my $self = shift;
 243   grep { $_->quantity } qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
 244 }
 245
 246 =item svcpart [ SVCDB ]
 247
 248 Returns the svcpart of a single service definition (see L<FS::part_svc>)
 249 associated with this billing item definition (see L<FS::pkg_svc>).  Returns
 250 false if there not exactly one service definition with quantity 1, or if
 251 SVCDB is specified and does not match the svcdb of the service definition,
 252
 253 =cut
 254
 255 sub svcpart {
 256   my $self = shift;
 257   my $svcdb = shift;
 258   my @pkg_svc = $self->pkg_svc;
 259   return '' if scalar(@pkg_svc) != 1
 260                || $pkg_svc[0]->quantity != 1
 261                || ( $svcdb && $pkg_svc[0]->part_svc->svcdb ne $svcdb );
 262   $pkg_svc[0]->svcpart;
 263 }
 264
 265 =back
 266
 267 =head1 VERSION
 268
 269 $Id: part_pkg.pm,v 1.9 2002-03-24 17:42:58 ivan Exp $
 270
 271 =head1 BUGS
 272
 273 The delete method is unimplemented.
 274
 275 setup and recur semantics are not yet defined (and are implemented in
 276 FS::cust_bill.  hmm.).
 277
 278 =head1 SEE ALSO
 279
 280 L<FS::Record>, L<FS::cust_pkg>, L<FS::type_pkgs>, L<FS::pkg_svc>, L<Safe>.
 281 schema.html from the base documentation.
 282
 283 =cut
 284
 285 1;
 286