site_perl/cust_pkg.pm

   1 package FS::cust_pkg;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 use Exporter;
   6 use FS::UID qw(getotaker);
   7 use FS::Record qw(fields qsearch qsearchs);
   8 use FS::cust_svc;
   9
  10 @ISA = qw(FS::Record Exporter);
  11
  12 =head1 NAME
  13
  14 FS::cust_pkg - Object methods for cust_pkg objects
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::cust_pkg;
  19
  20   $record = create FS::cust_pkg \%hash;
  21   $record = create FS::cust_pkg { 'column' => 'value' };
  22
  23   $error = $record->insert;
  24
  25   $error = $new_record->replace($old_record);
  26
  27   $error = $record->delete;
  28
  29   $error = $record->check;
  30
  31   $error = $record->cancel;
  32
  33   $error = $record->suspend;
  34
  35   $error = $record->unsuspend;
  36
  37   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
  38   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::cust_pkg object represents a customer billing item.  FS::cust_pkg
  43 inherits from FS::Record.  The following fields are currently supported:
  44
  45 =over 4
  46
  47 =item pkgnum - primary key (assigned automatically for new billing items)
  48
  49 =item custnum - Customer (see L<FS::cust_main>)
  50
  51 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
  52
  53 =item setup - date
  54
  55 =item bill - date
  56
  57 =item susp - date
  58
  59 =item expire - date
  60
  61 =item cancel - date
  62
  63 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
  64
  65 =back
  66
  67 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
  68 see L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for
  69 conversion functions.
  70
  71 =head1 METHODS
  72
  73 =over 4
  74
  75 =item create HASHREF
  76
  77 Create a new billing item.  To add the item to the database, see L<"insert">.
  78
  79 =cut
  80
  81 sub create {
  82   my($proto,$hashref)=@_;
  83
  84   #now in FS::Record::new
  85   #my($field);
  86   #foreach $field (fields('cust_pkg')) {
  87   #  $hashref->{$field}='' unless defined $hashref->{$field};
  88   #}
  89
  90   $proto->new('cust_pkg',$hashref);
  91 }
  92
  93 =item insert
  94
  95 Adds this billing item to the database ("Orders" the item).  If there is an
  96 error, returns the error, otherwise returns false.
  97
  98 =cut
  99
 100 sub insert {
 101   my($self)=@_;
 102
 103   $self->check or
 104   $self->add;
 105 }
 106
 107 =item delete
 108
 109 Currently unimplemented.  You don't want to delete billing items, because there
 110 would then be no record the customer ever purchased the item.  Instead, see
 111 the cancel method.
 112
 113 sub delete {
 114   return "Can't delete cust_pkg records!";
 115 }
 116
 117 =item replace OLD_RECORD
 118
 119 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 120 returns the error, otherwise returns false.
 121
 122 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
 123
 124 pkgpart may not be changed, but see the order subroutine.
 125
 126 setup and bill are normally updated by calling the bill method of a customer
 127 object (see L<FS::cust_main>).
 128
 129 suspend is normally updated by the suspend and unsuspend methods.
 130
 131 cancel is normally updated by the cancel method (and also the order subroutine
 132 in some cases).
 133
 134 =cut
 135
 136 sub replace {
 137   my($new,$old)=@_;
 138   return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
 139   return "Can't change pkgnum!"
 140     if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
 141   return "Can't (yet?) change pkgpart!"
 142     if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
 143   return "Can't change otaker!"
 144     if $old->getfield('otaker') ne $new->getfield('otaker');
 145   return "Can't change setup once it exists!"
 146     if $old->getfield('setup') &&
 147        $old->getfield('setup') != $new->getfield('setup');
 148   #some logic for bill, susp, cancel?
 149
 150   $new->check or
 151   $new->rep($old);
 152 }
 153
 154 =item check
 155
 156 Checks all fields to make sure this is a valid billing item.  If there is an
 157 error, returns the error, otherwise returns false.  Called by the insert and
 158 replace methods.
 159
 160 =cut
 161
 162 sub check {
 163   my($self)=@_;
 164   return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
 165   my($recref) = $self->hashref;
 166
 167   $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
 168   $recref->{pkgnum}=$1;
 169
 170   $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
 171   $recref->{custnum}=$1;
 172   return "Unknown customer"
 173     unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
 174
 175   $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
 176   $recref->{pkgpart}=$1;
 177   return "Unknown pkgpart"
 178     unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
 179
 180   $recref->{otaker} ||= &getotaker;
 181   $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
 182   $recref->{otaker}=$1;
 183
 184   $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
 185   $recref->{setup}=$1;
 186
 187   $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
 188   $recref->{bill}=$1;
 189
 190   $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
 191   $recref->{susp}=$1;
 192
 193   $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
 194   $recref->{cancel}=$1;
 195
 196   ''; #no error
 197 }
 198
 199 =item cancel
 200
 201 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
 202 in this package, then cancels the package itself (sets the cancel field to
 203 now).
 204
 205 If there is an error, returns the error, otherwise returns false.
 206
 207 =cut
 208
 209 sub cancel {
 210   my($self)=@_;
 211   my($error);
 212
 213   local $SIG{HUP} = 'IGNORE';
 214   local $SIG{INT} = 'IGNORE';
 215   local $SIG{QUIT} = 'IGNORE';
 216   local $SIG{TERM} = 'IGNORE';
 217   local $SIG{TSTP} = 'IGNORE';
 218
 219   my($cust_svc);
 220   foreach $cust_svc (
 221     qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
 222   ) {
 223     my($part_svc)=
 224       qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
 225
 226     $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
 227       or return "Illegal svcdb value in part_svc!";
 228     my($svcdb) = $1;
 229     require "FS/$svcdb.pm";
 230
 231     my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
 232     if ($svc) {
 233       bless($svc,"FS::$svcdb");
 234       $error = $svc->cancel;
 235       return "Error cancelling service: $error" if $error;
 236       $error = $svc->delete;
 237       return "Error deleting service: $error" if $error;
 238     }
 239
 240     bless($cust_svc,"FS::cust_svc");
 241     $error = $cust_svc->delete;
 242     return "Error deleting cust_svc: $error" if $error;
 243
 244   }
 245
 246   unless ( $self->getfield('cancel') ) {
 247     my(%hash) = $self->hash;
 248     $hash{'cancel'}=$^T;
 249     my($new) = create FS::cust_pkg ( \%hash );
 250     $error=$new->replace($self);
 251     return $error if $error;
 252   }
 253
 254   ''; #no errors
 255 }
 256
 257 =item suspend
 258
 259 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 260 package, then suspends the package itself (sets the susp field to now).
 261
 262 If there is an error, returns the error, otherwise returns false.
 263
 264 =cut
 265
 266 sub suspend {
 267   my($self)=@_;
 268   my($error);
 269   local $SIG{HUP} = 'IGNORE';
 270   local $SIG{INT} = 'IGNORE';
 271   local $SIG{QUIT} = 'IGNORE';
 272   local $SIG{TERM} = 'IGNORE';
 273   local $SIG{TSTP} = 'IGNORE';
 274
 275   my($cust_svc);
 276   foreach $cust_svc (
 277     qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
 278   ) {
 279     my($part_svc)=
 280       qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
 281
 282     $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
 283       or return "Illegal svcdb value in part_svc!";
 284     my($svcdb) = $1;
 285     require "FS/$svcdb.pm";
 286
 287     my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
 288
 289     if ($svc) {
 290       bless($svc,"FS::$svcdb");
 291       $error = $svc->suspend;
 292       return $error if $error;
 293     }
 294
 295   }
 296
 297   unless ( $self->getfield('susp') ) {
 298     my(%hash) = $self->hash;
 299     $hash{'susp'}=$^T;
 300     my($new) = create FS::cust_pkg ( \%hash );
 301     $error=$new->replace($self);
 302     return $error if $error;
 303   }
 304
 305   ''; #no errors
 306 }
 307
 308 =item unsuspend
 309
 310 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
 311 package, then unsuspends the package itself (clears the susp field).
 312
 313 If there is an error, returns the error, otherwise returns false.
 314
 315 =cut
 316
 317 sub unsuspend {
 318   my($self)=@_;
 319   my($error);
 320
 321   local $SIG{HUP} = 'IGNORE';
 322   local $SIG{INT} = 'IGNORE';
 323   local $SIG{QUIT} = 'IGNORE';
 324   local $SIG{TERM} = 'IGNORE';
 325   local $SIG{TSTP} = 'IGNORE';
 326
 327   my($cust_svc);
 328   foreach $cust_svc (
 329     qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
 330   ) {
 331     my($part_svc)=
 332       qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
 333
 334     $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
 335       or return "Illegal svcdb value in part_svc!";
 336     my($svcdb) = $1;
 337     require "FS/$svcdb.pm";
 338
 339     my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
 340     if ($svc) {
 341       bless($svc,"FS::$svcdb");
 342       $error = $svc->unsuspend;
 343       return $error if $error;
 344     }
 345
 346   }
 347
 348   unless ( ! $self->getfield('susp') ) {
 349     my(%hash) = $self->hash;
 350     $hash{'susp'}='';
 351     my($new) = create FS::cust_pkg ( \%hash );
 352     $error=$new->replace($self);
 353     return $error if $error;
 354   }
 355
 356   ''; #no errors
 357 }
 358
 359 =back
 360
 361 =head1 SUBROUTINES
 362
 363 =over 4
 364
 365 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
 366
 367 CUSTNUM is a customer (see L<FS::cust_main>)
 368
 369 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
 370 L<FS::part_pkg>) to order for this customer.  Duplicates are of course
 371 permitted.
 372
 373 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
 374 remove for this customer.  The services (see L<FS::cust_svc>) are moved to the
 375 new billing items.  An error is returned if this is not possible (see
 376 L<FS::pkg_svc>).
 377
 378 =cut
 379
 380 sub order {
 381   my($custnum,$pkgparts,$remove_pkgnums)=@_;
 382
 383   my(%part_pkg);
 384   # generate %part_pkg
 385   # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
 386     my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
 387     my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
 388
 389     my($type_pkgs);
 390     foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
 391       my($pkgpart)=$type_pkgs->pkgpart;
 392       $part_pkg{$pkgpart}++;
 393     }
 394   #
 395
 396   my(%svcnum);
 397   # generate %svcnum
 398   # for those packages being removed:
 399   #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
 400   # objects (table eq 'cust_svc')
 401   my($pkgnum);
 402   foreach $pkgnum ( @{$remove_pkgnums} ) {
 403     my($cust_svc);
 404     foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
 405       push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
 406     }
 407   }
 408
 409   my(@cust_svc);
 410   #generate @cust_svc
 411   # for those packages the customer is purchasing:
 412   # @{$pkgparts} is a list of said packages, by pkgpart
 413   # @cust_svc is a corresponding list of lists of FS::Record objects
 414   my($pkgpart);
 415   foreach $pkgpart ( @{$pkgparts} ) {
 416     return "Customer not permitted to purchase pkgpart $pkgpart!"
 417       unless $part_pkg{$pkgpart};
 418     push @cust_svc, [
 419       map {
 420         ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
 421       } (split(/,/,
 422        qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
 423       ))
 424     ];
 425   }
 426
 427   #check for leftover services
 428   foreach (keys %svcnum) {
 429     next unless @{ $svcnum{$_} };
 430     return "Leftover services!";
 431   }
 432
 433   #no leftover services, let's make changes.
 434
 435   local $SIG{HUP} = 'IGNORE';
 436   local $SIG{INT} = 'IGNORE';
 437   local $SIG{QUIT} = 'IGNORE';
 438   local $SIG{TERM} = 'IGNORE';
 439   local $SIG{TSTP} = 'IGNORE';
 440
 441   #first cancel old packages
 442 #  my($pkgnum);
 443   foreach $pkgnum ( @{$remove_pkgnums} ) {
 444     my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
 445     return "Package $pkgnum not found to remove!" unless $old;
 446     my(%hash) = $old->hash;
 447     $hash{'cancel'}=$^T;
 448     my($new) = create FS::cust_pkg ( \%hash );
 449     my($error)=$new->replace($old);
 450     return $error if $error;
 451   }
 452
 453   #now add new packages, changing cust_svc records if necessary
 454 #  my($pkgpart);
 455   while ($pkgpart=shift @{$pkgparts} ) {
 456
 457     my($new) = create FS::cust_pkg ( {
 458                                        'custnum' => $custnum,
 459                                        'pkgpart' => $pkgpart,
 460                                     } );
 461     my($error) = $new->insert;
 462     return $error if $error;
 463     my($pkgnum)=$new->getfield('pkgnum');
 464
 465     my($cust_svc);
 466     foreach $cust_svc ( @{ shift @cust_svc } ) {
 467       my(%hash) = $cust_svc->hash;
 468       $hash{'pkgnum'}=$pkgnum;
 469       my($new) = create FS::cust_svc ( \%hash );
 470       my($error)=$new->replace($cust_svc);
 471       return $error if $error;
 472     }
 473   }
 474
 475   ''; #no errors
 476 }
 477
 478 =back
 479
 480 =head1 BUGS
 481
 482 It doesn't properly override FS::Record yet.
 483
 484 sub order is not OO.  Perhaps it should be moved to FS::cust_main and made so?
 485
 486 In sub order, the @pkgparts array (passed by reference) is clobbered.
 487
 488 Also in sub order, no money is adjusted.  Once FS::part_pkg defines a standard
 489 method to pass dates to the recur_prog expression, it should do so.
 490
 491 =head1 SEE ALSO
 492
 493 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
 494 , L<FS::pkg_svc>, schema.html from the base documentation
 495
 496 =head1 HISTORY
 497
 498 ivan@voicenet.com 97-jul-1 - 21
 499
 500 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
 501
 502 pod ivan@sisd.com 98-sep-21
 503
 504 =cut
 505
 506 1;
 507