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