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