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