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