FS/FS/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 == $new->custnum;
 134   #return "Can't change _date!" unless $old->_date eq $new->_date;
 135   return "Can't change _date!" unless $old->_date == $new->_date;
 136   return "Can't change charged!" unless $old->charged == $new->charged;
 137   return "(New) owed can't be > (new) charged!" if $new->owed > $new->charged;
 138
 139   $new->SUPER::replace($old);
 140 }
 141
 142 =item check
 143
 144 Checks all fields to make sure this is a valid invoice.  If there is an error,
 145 returns the error, otherwise returns false.  Called by the insert and replace
 146 methods.
 147
 148 =cut
 149
 150 sub check {
 151   my $self = shift;
 152
 153   my $error =
 154     $self->ut_numbern('invnum')
 155     || $self->ut_number('custnum')
 156     || $self->ut_numbern('_date')
 157     || $self->ut_money('charged')
 158     || $self->ut_money('owed')
 159     || $self->ut_numbern('printed')
 160   ;
 161   return $error if $error;
 162
 163   return "Unknown customer"
 164     unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
 165
 166   $self->_date(time) unless $self->_date;
 167
 168   $self->printed(0) if $self->printed eq '';
 169
 170   ''; #no error
 171 }
 172
 173 =item previous
 174
 175 Returns a list consisting of the total previous balance for this customer,
 176 followed by the previous outstanding invoices (as FS::cust_bill objects also).
 177
 178 =cut
 179
 180 sub previous {
 181   my $self = shift;
 182   my $total = 0;
 183   my @cust_bill = sort { $a->_date <=> $b->_date }
 184     grep { $_->owed != 0 && $_->_date < $self->_date }
 185       qsearch( 'cust_bill', { 'custnum' => $self->custnum } )
 186   ;
 187   foreach ( @cust_bill ) { $total += $_->owed; }
 188   $total, @cust_bill;
 189 }
 190
 191 =item cust_bill_pkg
 192
 193 Returns the line items (see L<FS::cust_bill_pkg>) for this invoice.
 194
 195 =cut
 196
 197 sub cust_bill_pkg {
 198   my $self = shift;
 199   qsearch( 'cust_bill_pkg', { 'invnum' => $self->invnum } );
 200 }
 201
 202 =item cust_credit
 203
 204 Returns a list consisting of the total previous credited (see
 205 L<FS::cust_credit>) for this customer, followed by the previous outstanding
 206 credits (FS::cust_credit objects).
 207
 208 =cut
 209
 210 sub cust_credit {
 211   my $self = shift;
 212   my $total = 0;
 213   my @cust_credit = sort { $a->_date <=> $b->date }
 214     grep { $_->credited != 0 && $_->_date < $self->_date }
 215       qsearch('cust_credit', { 'custnum' => $self->custnum } )
 216   ;
 217   foreach (@cust_credit) { $total += $_->credited; }
 218   $total, @cust_credit;
 219 }
 220
 221 =item cust_pay
 222
 223 Returns all payments (see L<FS::cust_pay>) for this invoice.
 224
 225 =cut
 226
 227 sub cust_pay {
 228   my $self = shift;
 229   sort { $a->_date <=> $b->date }
 230     qsearch( 'cust_pay', { 'invnum' => $self->invnum } )
 231   ;
 232 }
 233
 234 =item print_text [TIME];
 235
 236 Returns an ASCII invoice, as a list of lines.
 237
 238 TIME an optional value used to control the printing of overdue messages.  The
 239 default is now.  It isn't the date of the invoice; that's the `_date' field.
 240 It is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 241 L<Time::Local> and L<Date::Parse> for conversion functions.
 242
 243 =cut
 244
 245 sub print_text {
 246
 247   my( $self, $today ) = ( shift, shift );
 248   $today ||= time;
 249   my $invnum = $self->invnum;
 250   my $cust_main = qsearchs('cust_main', { 'custnum', $self->custnum } );
 251   $cust_main->payname( $cust_main->first. ' '. $cust_main->getfield('last') )
 252     unless $cust_main->payname;
 253
 254   my( $pr_total, @pr_cust_bill ) = $self->previous; #previous balance
 255   my( $cr_total, @cr_cust_credit ) = $self->cust_credit; #credits
 256   my $balance_due = $self->owed + $pr_total - $cr_total;
 257
 258   #overdue?
 259   my $overdue = (
 260     $balance_due > 0
 261     && $today > $self->_date
 262     && $self->printed > 1
 263   );
 264
 265   #printing bits here (yuck!)
 266
 267   my @collect = ();
 268
 269   my($description,$amount);
 270   my(@buf);
 271
 272   #format address
 273   my($l,@address)=(0,'','','','','','','');
 274   $address[$l++] =
 275     $cust_main->payname.
 276       ( ( $cust_main->payby eq 'BILL' ) && $cust_main->payinfo
 277         ? " (P.O. #". $cust_main->payinfo. ")"
 278         : ''
 279       )
 280   ;
 281   $address[$l++]=$cust_main->company if $cust_main->company;
 282   $address[$l++]=$cust_main->address1;
 283   $address[$l++]=$cust_main->address2 if $cust_main->address2;
 284   $address[$l++]=$cust_main->city. ", ". $cust_main->state. "  ".
 285                  $cust_main->zip;
 286   $address[$l++]=$cust_main->country unless $cust_main->country eq 'US';
 287
 288   #previous balance
 289   foreach ( @pr_cust_bill ) {
 290     push @buf, (
 291       "Previous Balance, Invoice #". $_->invnum.
 292                  " (". time2str("%x",$_->_date). ")",
 293       '$'. sprintf("%10.2f",$_->owed)
 294     );
 295   }
 296   if (@pr_cust_bill) {
 297     push @buf,('','-----------');
 298     push @buf,('Total Previous Balance','$' . sprintf("%10.2f",$pr_total ) );
 299     push @buf,('','');
 300   }
 301
 302   #new charges
 303   foreach ( $self->cust_bill_pkg ) {
 304
 305     if ( $_->pkgnum ) {
 306
 307       my($cust_pkg)=qsearchs('cust_pkg', { 'pkgnum', $_->pkgnum } );
 308       my($part_pkg)=qsearchs('part_pkg',{'pkgpart'=>$cust_pkg->pkgpart});
 309       my($pkg)=$part_pkg->pkg;
 310
 311       if ( $_->setup != 0 ) {
 312         push @buf, ( "$pkg Setup",'$' . sprintf("%10.2f",$_->setup) );
 313         push @buf, map { "  ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
 314       }
 315
 316       if ( $_->recur != 0 ) {
 317         push @buf, (
 318           "$pkg (" . time2str("%x",$_->sdate) . " - " .
 319                                 time2str("%x",$_->edate) . ")",
 320           '$' . sprintf("%10.2f",$_->recur)
 321         );
 322         push @buf, map { "  ". $_->[0]. ": ". $_->[1], '' } $cust_pkg->labels;
 323       }
 324
 325     } else { #pkgnum Tax
 326       push @buf,("Tax",'$' . sprintf("%10.2f",$_->setup) )
 327         if $_->setup != 0;
 328     }
 329   }
 330
 331   push @buf,('','-----------');
 332   push @buf,('Total New Charges',
 333              '$' . sprintf("%10.2f",$self->charged) );
 334   push @buf,('','');
 335
 336   push @buf,('','-----------');
 337   push @buf,('Total Charges',
 338              '$' . sprintf("%10.2f",$self->charged + $pr_total) );
 339   push @buf,('','');
 340
 341   #credits
 342   foreach ( @cr_cust_credit ) {
 343     push @buf,(
 344       "Credit #". $_->crednum. " (" . time2str("%x",$_->_date) .")",
 345       '$' . sprintf("%10.2f",$_->credited)
 346     );
 347   }
 348
 349   #get & print payments
 350   foreach ( $self->cust_pay ) {
 351     push @buf,(
 352       "Payment received ". time2str("%x",$_->_date ),
 353       '$' . sprintf("%10.2f",$_->paid )
 354     );
 355   }
 356
 357   #balance due
 358   push @buf,('','-----------');
 359   push @buf,('Balance Due','$' .
 360     sprintf("%10.2f",$self->owed + $pr_total - $cr_total ) );
 361
 362   #now print
 363
 364   my $tot_lines = 50; #should be configurable
 365    #header is 17 lines
 366   my $tot_pages = int( scalar(@buf) / ( 2 * ( $tot_lines - 17 ) ) );
 367   $tot_pages++ if scalar(@buf) % ( 2 * ( $tot_lines - 17 ) );
 368
 369   my $page = 1;
 370   my $lines;
 371   while (@buf) {
 372     $lines = $tot_lines;
 373     my @header = &header(
 374       $page, $tot_pages, $self->_date, $self->invnum, @address
 375     );
 376     push @collect, @header;
 377     $lines -= scalar(@header);
 378
 379     while ( $lines-- && @buf ) {
 380       $description=shift(@buf);
 381       $amount=shift(@buf);
 382       push @collect, myswrite($description, $amount);
 383     }
 384     $page++;
 385   }
 386   while ( $lines-- ) {
 387     push @collect, myswrite('', '');
 388   }
 389
 390   return @collect;
 391
 392   sub header { #17 lines
 393     my ( $page, $tot_pages, $date, $invnum, @address ) = @_ ;
 394     push @address, '', '', '', '';
 395
 396     my @return = ();
 397     my $i = ' 'x32;
 398     push @return,
 399       '',
 400       $i. 'Invoice',
 401       $i. substr("Page $page of $tot_pages".' 'x10, 0, 20).
 402         time2str("%x", $date ). "  FS-". $invnum,
 403       '',
 404       '',
 405       $add1,
 406       $add2,
 407       $add3,
 408       $add4,
 409       '',
 410       splice @address, 0, 7;
 411     ;
 412     return map $_. "\n", @return;
 413   }
 414
 415   sub myswrite {
 416     my $format = <<END;
 417   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
 418 END
 419     $^A = '';
 420     formline( $format, @_ );
 421     return $^A;
 422   }
 423
 424 }
 425
 426 =back
 427
 428 =head1 VERSION
 429
 430 $Id: cust_bill.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
 431
 432 =head1 BUGS
 433
 434 The delete method.
 435
 436 print_text formatting (and some logic :/) is in source, but needs to be
 437 slurped in from a file.  Also number of lines ($=).
 438
 439 missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style
 440 or something similar so the look can be completely customized?)
 441
 442 =head1 SEE ALSO
 443
 444 L<FS::Record>, L<FS::cust_main>, L<FS::cust_pay>, L<FS::cust_bill_pkg>,
 445 L<FS::cust_credit>, schema.html from the base documentation.
 446
 447 =cut
 448
 449 1;
 450