site_perl/cust_bill.pm

   1 package FS::cust_bill;
   2
   3 use strict;
   4 use vars qw( @ISA $conf $add1 $add2 $add3 $add4 );
   5 use Date::Format;
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::cust_main;
   8 use FS::cust_bill_pkg;
   9 use FS::cust_credit;
  10 use FS::cust_pay;
  11 use FS::cust_pkg;
  12
  13 @ISA = qw( FS::Record );
  14
  15 #ask FS::UID to run this stuff for us later
  16 $FS::UID::callback{'FS::cust_bill'} = sub {
  17   $conf = new FS::Conf;
  18   ( $add1, $add2, $add3, $add4 ) = $conf->config('address');
  19 };
  20
  21 =head1 NAME
  22
  23 FS::cust_bill - Object methods for cust_bill records
  24
  25 =head1 SYNOPSIS
  26
  27   use FS::cust_bill;
  28
  29   $record = new FS::cust_bill \%hash;
  30   $record = new FS::cust_bill { 'column' => 'value' };
  31
  32   $error = $record->insert;
  33
  34   $error = $new_record->replace($old_record);
  35
  36   $error = $record->delete;
  37
  38   $error = $record->check;
  39
  40   ( $total_previous_balance, @previous_cust_bill ) = $record->previous;
  41
  42   @cust_bill_pkg_objects = $cust_bill->cust_bill_pkg;
  43
  44   ( $total_previous_credits, @previous_cust_credit ) = $record->cust_credit;
  45
  46   @cust_pay_objects = $cust_bill->cust_pay;
  47
  48   @lines = $cust_bill->print_text;
  49   @lines = $cust_bill->print_text $time;
  50
  51 =head1 DESCRIPTION
  52
  53 An FS::cust_bill object represents an invoice.  FS::cust_bill inherits from
  54 FS::Record.  The following fields are currently supported:
  55
  56 =over 4
  57
  58 =item invnum - primary key (assigned automatically for new invoices)
  59
  60 =item custnum - customer (see L<FS::cust_main>)
  61
  62 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
  63 L<Time::Local> and L<Date::Parse> for conversion functions.
  64
  65 =item charged - amount of this invoice
  66
  67 =item owed - amount still outstanding on this invoice, which is charged minus
  68 all payments (see L<FS::cust_pay>).
  69
  70 =item printed - how many times this invoice has been printed automatically
  71 (see L<FS::cust_main/"collect">).
  72
  73 =back
  74
  75 =head1 METHODS
  76
  77 =over 4
  78
  79 =item new HASHREF
  80
  81 Creates a new invoice.  To add the invoice to the database, see L<"insert">.
  82 Invoices are normally created by calling the bill method of a customer object
  83 (see L<FS::cust_main>).
  84
  85 =cut
  86
  87 sub table { 'cust_bill'; }
  88
  89 =item insert
  90
  91 Adds this invoice to the database ("Posts" the invoice).  If there is an error,
  92 returns the error, otherwise returns false.
  93
  94 When adding new invoices, owed must be charged (or null, in which case it is
  95 automatically set to charged).
  96
  97 =cut
  98
  99 sub insert {
 100   my $self = shift;
 101
 102   $self->owed( $self->charged ) if $self->owed eq '';
 103   return "owed != charged!"
 104     unless $self->owed == $self->charged;
 105
 106   $self->SUPER::insert;
 107 }
 108
 109 =item delete
 110
 111 Currently unimplemented.  I don't remove invoices because there would then be
 112 no record you ever posted this invoice (which is bad, no?)
 113
 114 =cut
 115
 116 sub delete {
 117   return "Can't remove invoice!"
 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 Only owed and printed may be changed.  Owed is normally updated by creating and
 126 inserting a payment (see L<FS::cust_pay>).  Printed is normally updated by
 127 calling the collect method of a customer object (see L<FS::cust_main>).
 128
 129 =cut
 130
 131 sub replace {
 132   my( $new, $old ) = ( shift, shift );
 133   return "Can't change custnum!" unless $old->custnum eq $new->custnum;
 134   return "Can't change _date!" unless $old->_date eq $new->_date;
 135   return "Can't change charged!" unless $old->charged eq $new->charged;
 136   return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged;
 137
 138   $new->SUPER::replace($old);
 139 }
 140
 141 =item check
 142
 143 Checks all fields to make sure this is a valid invoice.  If there is an error,
 144 returns the error, otherwise returns false.  Called by the insert and replace
 145 methods.
 146
 147 =cut
 148
 149 sub check {
 150   my $self = shift;
 151
 152   my $error =
 153     $self->ut_numbern('invnum')
 154     || $self->ut_number('custnum')
 155     || $self->ut_numbern('_date')
 156     || $self->ut_money('charged')
 157     || $self->ut_money('owed')
 158     || $self->ut_numbern('printed')
 159   ;
 160   return $error if $error;
 161
 162   return "Unknown customer"
 163     unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 164
 165   $self->_date(time) unless $self->_date;
 166
 167   $self->printed(0) if $self->printed eq '';
 168
 169   ''; #no error
 170 }
 171
 172 =item previous
 173
 174 Returns a list consisting of the total previous balance for this customer,
 175 followed by the previous outstanding invoices (as FS::cust_bill objects also).
 176
 177 =cut
 178
 179 sub previous {
 180   my $self = shift;
 181   my $total = 0;
 182   my @cust_bill = sort { $a->_date <=> $b->_date }
 183     grep { $_->owed != 0 && $_->_date < $self->_date }
 184       qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
 185   ;
 186   foreach ( @cust_bill ) { $total += $_->owed; }
 187   $total, @cust_bill;
 188 }
 189
 190 =item cust_bill_pkg
 191
 192 Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
 193
 194 =cut
 195
 196 sub cust_bill_pkg {
 197   my $self = shift;
 198   qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
 199 }
 200
 201 =item cust_credit
 202
 203 Returns a list consisting of the total previous credited (see
 204 L<FS::cust_credit>) for this customer, followed by the previous outstanding
 205 credits (FS::cust_credit objects).
 206
 207 =cut
 208
 209 sub cust_credit {
 210   my $self = shift;
 211   my $total = 0;
 212   my @cust_credit = sort { $a->_date <=> $b->date }
 213     grep { $_->credited != 0 && $_->_date < $self->_date }
 214       qsearch('cust_credit', { 'custnum' => $self->custnum } )
 215   ;
 216   foreach (@cust_credit) { $total += $_->credited; }
 217   $total, @cust_credit;
 218 }
 219
 220 =item cust_pay
 221
 222 Returns all payments (see L<FS::cust_pay>) for this invoice.
 223
 224 =cut
 225
 226 sub cust_pay {
 227   my $self = shift;
 228   sort { $a->_date <=> $b->date }
 229     qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
 230   ;
 231 }
 232
 233 =item print_text [TIME];
 234
 235 Returns an ASCII invoice, as a list of lines.
 236
 237 TIME an optional value used to control the printing of overdue messages.  The
 238 default is now.  It isn't the date of the invoice; that's the `_date' field.
 239 It is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 240 L<Time::Local> and L<Date::Parse> for conversion functions.
 241
 242 =cut
 243
 244 sub print_text {
 245
 246   my( $self, $today ) = ( shift, shift );
 247   $today ||= time;
 248   my $invnum = $self->invnum;
 249   my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } );
 250   $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
 251     unless $cust_main->payname;
 252
 253   my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
 254   my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
 255   my $balance_due = $self->owed + $pr_total - $cr_total;
 256
 257   #overdue?
 258   my $overdue = (
 259     $balance_due > 0
 260     && $today > $self->_date
 261     && $self->printed > 1
 262   );
 263
 264   #printing bits here (yuck!)
 265
 266   local($SIG{CHLD}) = sub { wait() };
 267   $|=1;
 268   my($pid)=open(CHILD,"-|");
 269   die "Can't fork: $!" unless defined($pid);
 270
 271   if ($pid) { #parent
 272     my(@collect)=<CHILD>;
 273     close CHILD;
 274     return @collect;
 275   } else { #child
 276
 277     my($description,$amount);
 278     my(@buf);
 279
 280     #define format stuff
 281     $%=0;
 282     $= = 35;
 283     local($^L) = <<END;
 284
 285
 286
 287
 288
 289
 290
 291 END
 292
 293     #format address
 294     my($l,@address)=(0,'','','','','');
 295     $address[$l++]=$cust_main->company if $cust_main->company;
 296     $address[$l++]=$cust_main->address1;
 297     $address[$l++]=$cust_main->address2 if $cust_main->address2;
 298     $address[$l++]=$cust_main->city. ", ". $cust_main->state. "  ".
 299                    $cust_main->zip;
 300     $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
 301
 302     #previous balance
 303     foreach ( @pr_cust_bill ) {
 304       push @buf, (
 305         "Previous Balance, Invoice #". $_->invnum.
 306                    " (". time2str("%x",$_->_date). ")",
 307         '$'. sprintf("%10.2f",$_->owed)
 308       );
 309     }
 310     if (@pr_cust_bill) {
 311       push @buf,('','-----------');
 312       push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
 313       push @buf,('','');
 314     }
 315
 316     #new charges
 317     foreach ( $self->cust_bill_pkg ) {
 318
 319       if ( $_->pkgnum ) {
 320
 321         my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
 322         my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
 323         my($pkg)=$part_pkg->pkg;
 324
 325         push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) )
 326           if $_->setup != 0;
 327         push @buf, (
 328           "$pkg (" . time2str("%x",$_->sdate) . " - " .
 329                                 time2str("%x",$_->edate) . ")",
 330           '$' . sprintf("%10.2f",$_->recur)
 331         ) if $_->recur != 0;
 332
 333       } else { #pkgnum Tax
 334         push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
 335           if $_->setup != 0;
 336       }
 337     }
 338
 339     push @buf,('','-----------');
 340     push @buf,('Total New Charges',
 341                '$' . sprintf("%10.2f",$self->charged) );
 342     push @buf,('','');
 343
 344     push @buf,('','-----------');
 345     push @buf,('Total Charges',
 346                '$' . sprintf("%10.2f",$self->charged + $pr_total) );
 347     push @buf,('','');
 348
 349     #credits
 350     foreach ( @cr_cust_credit ) {
 351       push @buf,(
 352         "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
 353         '$' . sprintf("%10.2f",$_->credited)
 354       );
 355     }
 356
 357     #get & print payments
 358     foreach ( $self->cust_pay ) {
 359       push @buf,(
 360         "Payment received ". time2str("%x",$_->_date ),
 361         '$' . sprintf("%10.2f",$_->paid )
 362       );
 363     }
 364
 365     #balance due
 366     push @buf,('','-----------');
 367     push @buf,('Balance Due','$' .
 368       sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
 369
 370     #now print
 371
 372     my($tot_pages)=int(scalar(@buf)/30); #15 lines, 2 values per line
 373     $tot_pages++ if scalar(@buf) % 30;
 374
 375     while (@buf) {
 376       $description=shift(@buf);
 377       $amount=shift(@buf);
 378       write;
 379     }
 380       ($description,$amount)=('','');
 381       write while ( $- );
 382       print $^L;
 383
 384       exit; #kid
 385
 386     format STDOUT_TOP =
 387
 388                                       @|||||||||||||||||||
 389                                      "Invoice"
 390                                       @||||||||||||||||||| @<<<<<<< @<<<<<<<<<<<
 391 {
 392               ( $tot_pages != 1 ) ? "Page $% of $tot_pages" : '',
 393   time2str("%x",( $self->_date )), "FS-$invnum"
 394 }
 395
 396
 397 @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 398 $add1
 399 @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 400 $add2
 401 @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 402 $add3
 403 @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 404 $add4
 405
 406   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 407 { $cust_main->payname,
 408   ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo )
 409   ? "P.O. #". $cust_main->payinfo : ''
 410 }
 411   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 412 $address[0],''
 413   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 414 $address[1],$overdue ? "* This invoice is now PAST DUE! *" : ''
 415   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 416 $address[2],$overdue ? " Please forward payment promptly " : ''
 417   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 418 $address[3],$overdue ? "to avoid interruption of service." : ''
 419   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 420 $address[4],''
 421
 422
 423
 424 .
 425
 426     format STDOUT =
 427   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
 428   $description,$amount
 429 .
 430
 431   } #endchild
 432
 433 }
 434
 435 =back
 436
 437 =head1 VERSION
 438
 439 $Id: cust_bill.pm,v 1.4 1998-12-29 11:59:36 ivan Exp $
 440
 441 =head1 BUGS
 442
 443 The delete method.
 444
 445 print_text formatting (and some logic :/) is in source as a format declaration,
 446 which needs to be slurped in from a file.  the fork is rather kludgy as well.
 447 It could be cleaned with swrite from man perlform, and the picture could be
 448 put in a /var/spool/freeside/conf file.  Also number of lines ($=).
 449
 450 missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
 451 or something similar so the look can be completely customized?)
 452
 453 There is an off-by-one error in print_text which causes a visual error: "Page 1
 454 of 2" printed on some single-page invoices?
 455
 456 =head1 SEE ALSO
 457
 458 L<FS::Record>, L<FS::cust_main>, L<FS::cust_pay>, L<FS::cust_bill_pkg>,
 459 L<FS::cust_credit>, schema.html from the base documentation.
 460
 461 =head1 HISTORY
 462
 463 ivan@voicenet.com 97-jul-1
 464
 465 small fix for new API ivan@sisd.com 98-mar-14
 466
 467 charges can be negative ivan@sisd.com 98-jul-13
 468
 469 pod, ingegrate with FS::Invoice ivan@sisd.com 98-sep-20
 470
 471 $Log: cust_bill.pm,v $
 472 Revision 1.4  1998-12-29 11:59:36  ivan
 473 mostly properly OO, some work still to be done with svc_ stuff
 474
 475 Revision 1.3  1998/11/13 09:56:53  ivan
 476 change configuration file layout to support multiple distinct databases (with
 477 own set of config files, export, etc.)
 478
 479 Revision 1.2  1998/11/07 10:24:24  ivan
 480 don't use depriciated FS::Bill and FS::Invoice, other miscellania
 481
 482
 483 =cut
 484
 485 1;
 486