site_perl/cust_pkg.pm

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