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