import torrus 1.0.9
[freeside.git] / FS / FS / cust_bill_pkg.pm
index 62c0d58..d396f82 100644 (file)
@@ -1,18 +1,27 @@
 package FS::cust_bill_pkg;
 
 use strict;
-use vars qw( @ISA );
+use vars qw( @ISA $DEBUG $me );
+use Carp;
 use FS::Record qw( qsearch qsearchs dbdef dbh );
 use FS::cust_main_Mixin;
 use FS::cust_pkg;
 use FS::part_pkg;
 use FS::cust_bill;
 use FS::cust_bill_pkg_detail;
+use FS::cust_bill_pkg_display;
 use FS::cust_bill_pay_pkg;
 use FS::cust_credit_bill_pkg;
+use FS::cust_tax_exempt_pkg;
+use FS::cust_bill_pkg_tax_location;
+use FS::cust_bill_pkg_tax_rate_location;
+use FS::cust_tax_adjustment;
 
 @ISA = qw( FS::cust_main_Mixin FS::Record );
 
+$DEBUG = 0;
+$me = '[FS::cust_bill_pkg]';
+
 =head1 NAME
 
 FS::cust_bill_pkg - Object methods for cust_bill_pkg records
@@ -26,10 +35,6 @@ FS::cust_bill_pkg - Object methods for cust_bill_pkg records
 
   $error = $record->insert;
 
-  $error = $new_record->replace($old_record);
-
-  $error = $record->delete;
-
   $error = $record->check;
 
 =head1 DESCRIPTION
@@ -40,28 +45,57 @@ supported:
 
 =over 4
 
-=item billpkgnum - primary key
+=item billpkgnum
+
+primary key
+
+=item invnum
+
+invoice (see L<FS::cust_bill>)
+
+=item pkgnum
 
-=item invnum - invoice (see L<FS::cust_bill>)
+package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line)
 
-=item pkgnum - package (see L<FS::cust_pkg>) or 0 for the special virtual sales tax package, or -1 for the virtual line item (itemdesc is used for the line)
+=item pkgpart_override
 
-=item pkgpart_override - optional package definition (see L<FS::part_pkg>) override
-=item setup - setup fee
+optional package definition (see L<FS::part_pkg>) override
 
-=item recur - recurring fee
+=item setup
 
-=item sdate - starting date of recurring fee
+setup fee
 
-=item edate - ending date of recurring fee
+=item recur
 
-=item itemdesc - Line item description (overrides normal package description)
+recurring fee
 
-=item quantity - If not set, defaults to 1
+=item sdate
 
-=item unitsetup - If not set, defaults to setup
+starting date of recurring fee
+
+=item edate
+
+ending date of recurring fee
+
+=item itemdesc
+
+Line item description (overrides normal package description)
+
+=item quantity
 
-=item unitrecur - If not set, defaults to recur
+If not set, defaults to 1
+
+=item unitsetup
+
+If not set, defaults to setup
+
+=item unitrecur
+
+If not set, defaults to recur
+
+=item hidden
+
+If set to Y, indicates data should not appear as separate line item on invoice
 
 =back
 
@@ -109,21 +143,90 @@ sub insert {
     return $error;
   }
 
-  unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) {
-    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
-    return '';
+  if ( $self->get('details') ) {
+    foreach my $detail ( @{$self->get('details')} ) {
+      my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
+        'billpkgnum' => $self->billpkgnum,
+        'format'     => (ref($detail) ? $detail->[0] : '' ),
+        'detail'     => (ref($detail) ? $detail->[1] : $detail ),
+        'amount'     => (ref($detail) ? $detail->[2] : '' ),
+        'classnum'   => (ref($detail) ? $detail->[3] : '' ),
+        'phonenum'   => (ref($detail) ? $detail->[4] : '' ),
+        'duration'   => (ref($detail) ? $detail->[5] : '' ),
+        'regionname' => (ref($detail) ? $detail->[6] : '' ),
+      };
+      $error = $cust_bill_pkg_detail->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_bill_pkg_detail: $error";
+      }
+    }
   }
 
-  foreach my $detail ( @{$self->get('details')} ) {
-    my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
-      'billpkgnum' => $self->billpkgnum,
-      'format'     => (ref($detail) ? $detail->[0] : '' ),
-      'detail'     => (ref($detail) ? $detail->[1] : $detail ),
-    };
-    $error = $cust_bill_pkg_detail->insert;
+  if ( $self->get('display') ) {
+    foreach my $cust_bill_pkg_display ( @{ $self->get('display') } ) {
+      $cust_bill_pkg_display->billpkgnum($self->billpkgnum);
+      $error = $cust_bill_pkg_display->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_bill_pkg_display: $error";
+      }
+    }
+  }
+
+  if ( $self->get('discounts') ) {
+    foreach my $cust_bill_pkg_discount ( @{$self->get('discounts')} ) {
+      $cust_bill_pkg_discount->billpkgnum($self->billpkgnum);
+      $error = $cust_bill_pkg_discount->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_bill_pkg_discount: $error";
+      }
+    }
+  }
+
+  if ( $self->_cust_tax_exempt_pkg ) {
+    foreach my $cust_tax_exempt_pkg ( @{$self->_cust_tax_exempt_pkg} ) {
+      $cust_tax_exempt_pkg->billpkgnum($self->billpkgnum);
+      $error = $cust_tax_exempt_pkg->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_tax_exempt_pkg: $error";
+      }
+    }
+  }
+
+  my $tax_location = $self->get('cust_bill_pkg_tax_location');
+  if ( $tax_location ) {
+    foreach my $cust_bill_pkg_tax_location ( @$tax_location ) {
+      $cust_bill_pkg_tax_location->billpkgnum($self->billpkgnum);
+      $error = $cust_bill_pkg_tax_location->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_bill_pkg_tax_location: $error";
+      }
+    }
+  }
+
+  my $tax_rate_location = $self->get('cust_bill_pkg_tax_rate_location');
+  if ( $tax_rate_location ) {
+    foreach my $cust_bill_pkg_tax_rate_location ( @$tax_rate_location ) {
+      $cust_bill_pkg_tax_rate_location->billpkgnum($self->billpkgnum);
+      $error = $cust_bill_pkg_tax_rate_location->insert;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return "error inserting cust_bill_pkg_tax_rate_location: $error";
+      }
+    }
+  }
+
+  my $cust_tax_adjustment = $self->get('cust_tax_adjustment');
+  if ( $cust_tax_adjustment ) {
+    $cust_tax_adjustment->billpkgnum($self->billpkgnum);
+    $error = $cust_tax_adjustment->replace;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return $error;
+      return "error replacing cust_tax_adjustment: $error";
     }
   }
 
@@ -134,26 +237,80 @@ sub insert {
 
 =item delete
 
-Currently unimplemented.  I don't remove line items because there would then be
-no record the items ever existed (which is bad, no?)
+Not recommended.
 
 =cut
 
 sub delete {
-  return "Can't delete cust_bill_pkg records!";
-}
+  my $self = shift;
 
-=item replace OLD_RECORD
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $table (qw(
+    cust_bill_pkg_detail
+    cust_bill_pkg_display
+    cust_bill_pkg_tax_location
+    cust_bill_pkg_tax_rate_location
+    cust_tax_exempt_pkg
+    cust_bill_pay_pkg
+    cust_credit_bill_pkg
+  )) {
+
+    foreach my $linked ( qsearch($table, { billpkgnum=>$self->billpkgnum }) ) {
+      my $error = $linked->delete;
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
 
-Currently unimplemented.  This would be even more of an accounting nightmare
-than deleteing the items.  Just don't do it.
+  }
 
-=cut
+  foreach my $cust_tax_adjustment (
+    qsearch('cust_tax_adjustment', { billpkgnum=>$self->billpkgnum })
+  ) {
+    $cust_tax_adjustment->billpkgnum(''); #NULL
+    my $error = $cust_tax_adjustment->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $self->SUPER::delete(@_);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
 
-sub replace {
-  return "Can't modify cust_bill_pkg records!";
 }
 
+#alas, bin/follow-tax-rename
+#
+#=item replace OLD_RECORD
+#
+#Currently unimplemented.  This would be even more of an accounting nightmare
+#than deleteing the items.  Just don't do it.
+#
+#=cut
+#
+#sub replace {
+#  return "Can't modify cust_bill_pkg records!";
+#}
+
 =item check
 
 Checks all fields to make sure this is a valid line item.  If there is an
@@ -174,6 +331,8 @@ sub check {
       || $self->ut_numbern('sdate')
       || $self->ut_numbern('edate')
       || $self->ut_textn('itemdesc')
+      || $self->ut_textn('itemcomment')
+      || $self->ut_enum('hidden', [ '', 'Y' ])
   ;
   return $error if $error;
 
@@ -197,6 +356,7 @@ Returns the package (see L<FS::cust_pkg>) for this invoice line item.
 
 sub cust_pkg {
   my $self = shift;
+  carp "$me $self -> cust_pkg" if $DEBUG;
   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 }
 
@@ -211,7 +371,10 @@ sub part_pkg {
   if ( $self->pkgpart_override ) {
     qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } );
   } else {
-    $self->cust_pkg->part_pkg;
+    my $part_pkg;
+    my $cust_pkg = $self->cust_pkg;
+    $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
+    $part_pkg;
   }
 }
 
@@ -226,6 +389,24 @@ sub cust_bill {
   qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 }
 
+=item previous_cust_bill_pkg
+
+Returns the previous cust_bill_pkg for this package, if any.
+
+=cut
+
+sub previous_cust_bill_pkg {
+  my $self = shift;
+  return unless $self->sdate;
+  qsearchs({
+    'table'    => 'cust_bill_pkg',
+    'hashref'  => { 'pkgnum' => $self->pkgnum,
+                    'sdate'  => { op=>'<', value=>$self->sdate },
+                  },
+    'order_by' => 'ORDER BY sdate DESC LIMIT 1',
+  });
+}
+
 =item details [ OPTION => VALUE ... ]
 
 Returns an array of detail information for the invoice line item.
@@ -274,10 +455,10 @@ sub details {
                       foreach ($csv->fields) {
                         $result .= ' & ' if $column > 1;
                         if ($column > 6) {                     # KLUDGE ALERT!
-                          $result .= '\multicolumn{1}{l}{\small{'.
+                          $result .= '\multicolumn{1}{l}{\scriptsize{'.
                                      &$escape_function($_). '}}';
                         }else{
-                          $result .= '\small{'.  &$escape_function($_). '}';
+                          $result .= '\scriptsize{'.  &$escape_function($_). '}';
                         }
                         $column++;
                       }
@@ -285,8 +466,10 @@ sub details {
                     }
     if $format eq 'latex';
 
+  $format_sub = $opt{format_function} if $opt{format_function};
+
   map { ( $_->format eq 'C'
-          ? &{$format_sub}( $_->detail )
+          ? &{$format_sub}( $_->detail, $_ )
           : &{$escape_function}( $_->detail )
         )
       }
@@ -297,6 +480,35 @@ sub details {
     #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum });
 }
 
+=item details_header [ OPTION => VALUE ... ]
+
+Returns a list representing an invoice line item detail header, if any.
+This relies on the behavior of voip_cdr in that it expects the header
+to be the first CSV formatted detail (as is expected by invoice generation
+routines).  Returns the empty list otherwise.
+
+=cut
+
+sub details_header {
+  my $self = shift;
+  return '' unless defined dbdef->table('cust_bill_pkg_detail');
+
+  eval "use Text::CSV_XS;";
+  die $@ if $@;
+  my $csv = new Text::CSV_XS;
+
+  my @detail = 
+    qsearch ({ 'table'    => 'cust_bill_pkg_detail',
+               'hashref'  => { 'billpkgnum' => $self->billpkgnum,
+                               'format'     => 'C',
+                             },
+               'order_by' => 'ORDER BY detailnum LIMIT 1',
+            });
+  return() unless scalar(@detail);
+  $csv->parse($detail[0]->detail) or return ();
+  $csv->fields;
+}
+
 =item desc
 
 Returns a description for this line item.  For typical line items, this is the
@@ -312,7 +524,9 @@ sub desc {
   if ( $self->pkgnum > 0 ) {
     $self->itemdesc || $self->part_pkg->pkg;
   } else {
-    $self->itemdesc || 'Tax';
+    my $desc = $self->itemdesc || 'Tax';
+    $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/;
+    $desc;
   }
 }
 
@@ -355,6 +569,16 @@ sub owed {
   $balance;
 }
 
+#modeled after owed
+sub payable {
+  my( $self, $field ) = @_;
+  my $balance = $self->$field();
+  $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
+  $balance = sprintf( '%.2f', $balance );
+  $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
+  $balance;
+}
+
 sub cust_bill_pay_pkg {
   my( $self, $field ) = @_;
   qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
@@ -380,7 +604,7 @@ line item.
 
 sub units {
   my $self = shift;
-  $self->part_pkg->calc_units($self->cust_pkg);
+  $self->pkgnum ? $self->part_pkg->calc_units($self->cust_pkg) : 0; # 1?
 }
 
 =item quantity
@@ -423,6 +647,233 @@ sub unitrecur {
     : $self->getfield('unitrecur');
 }
 
+=item disintegrate
+
+Returns a list of cust_bill_pkg objects each with no more than a single class
+(including setup or recur) of charge.
+
+=cut
+
+sub disintegrate {
+  my $self = shift;
+  # XXX this goes away with cust_bill_pkg refactor
+
+  my $cust_bill_pkg = new FS::cust_bill_pkg { $self->hash };
+  my %cust_bill_pkg = ();
+
+  $cust_bill_pkg{setup} = $cust_bill_pkg if $cust_bill_pkg->setup;
+  $cust_bill_pkg{recur} = $cust_bill_pkg if $cust_bill_pkg->recur;
+
+
+  #split setup and recur
+  if ($cust_bill_pkg->setup && $cust_bill_pkg->recur) {
+    my $cust_bill_pkg_recur = new FS::cust_bill_pkg { $cust_bill_pkg->hash };
+    $cust_bill_pkg->set('details', []);
+    $cust_bill_pkg->recur(0);
+    $cust_bill_pkg->unitrecur(0);
+    $cust_bill_pkg->type('');
+    $cust_bill_pkg_recur->setup(0);
+    $cust_bill_pkg_recur->unitsetup(0);
+    $cust_bill_pkg{recur} = $cust_bill_pkg_recur;
+
+  }
+
+  #split usage from recur
+  my $usage = sprintf( "%.2f", $cust_bill_pkg{recur}->usage )
+    if exists($cust_bill_pkg{recur});
+  warn "usage is $usage\n" if $DEBUG > 1;
+  if ($usage) {
+    my $cust_bill_pkg_usage =
+        new FS::cust_bill_pkg { $cust_bill_pkg{recur}->hash };
+    $cust_bill_pkg_usage->recur( $usage );
+    $cust_bill_pkg_usage->type( 'U' );
+    my $recur = sprintf( "%.2f", $cust_bill_pkg{recur}->recur - $usage );
+    $cust_bill_pkg{recur}->recur( $recur );
+    $cust_bill_pkg{recur}->type( '' );
+    $cust_bill_pkg{recur}->set('details', []);
+    $cust_bill_pkg{''} = $cust_bill_pkg_usage;
+  }
+
+  #subdivide usage by usage_class
+  if (exists($cust_bill_pkg{''})) {
+    foreach my $class (grep { $_ } $self->usage_classes) {
+      my $usage = sprintf( "%.2f", $cust_bill_pkg{''}->usage($class) );
+      my $cust_bill_pkg_usage =
+          new FS::cust_bill_pkg { $cust_bill_pkg{''}->hash };
+      $cust_bill_pkg_usage->recur( $usage );
+      $cust_bill_pkg_usage->set('details', []);
+      my $classless = sprintf( "%.2f", $cust_bill_pkg{''}->recur - $usage );
+      $cust_bill_pkg{''}->recur( $classless );
+      $cust_bill_pkg{$class} = $cust_bill_pkg_usage;
+    }
+    warn "Unexpected classless usage value: ". $cust_bill_pkg{''}->recur
+      if ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur < 0);
+    delete $cust_bill_pkg{''}
+      unless ($cust_bill_pkg{''}->recur && $cust_bill_pkg{''}->recur > 0);
+  }
+
+#  # sort setup,recur,'', and the rest numeric && return
+#  my @result = map { $cust_bill_pkg{$_} }
+#               sort { my $ad = ($a=~/^\d+$/); my $bd = ($b=~/^\d+$/);
+#                      ( $ad cmp $bd ) || ( $ad ? $a<=>$b : $b cmp $a )
+#                    }
+#               keys %cust_bill_pkg;
+#
+#  return (@result);
+
+   %cust_bill_pkg;
+}
+
+=item usage CLASSNUM
+
+Returns the amount of the charge associated with usage class CLASSNUM if
+CLASSNUM is defined.  Otherwise returns the total charge associated with
+usage.
+  
+=cut
+
+sub usage {
+  my( $self, $classnum ) = @_;
+  my $sum = 0;
+  my @values = ();
+
+  if ( $self->get('details') ) {
+
+    @values = 
+      map { $_->[2] }
+      grep { ref($_) && ( defined($classnum) ? $_->[3] eq $classnum : 1 ) }
+      @{ $self->get('details') };
+
+  }else{
+
+    my $hashref = { 'billpkgnum' => $self->billpkgnum };
+    $hashref->{ 'classnum' } = $classnum if defined($classnum);
+    @values = map { $_->amount } qsearch('cust_bill_pkg_detail', $hashref);
+
+  }
+
+  foreach ( @values ) {
+    $sum += $_ if $_;
+  }
+  $sum;
+}
+
+=item usage_classes
+
+Returns a list of usage classnums associated with this invoice line's
+details.
+  
+=cut
+
+sub usage_classes {
+  my( $self ) = @_;
+
+  if ( $self->get('details') ) {
+
+    my %seen = ();
+    foreach my $detail ( grep { ref($_) } @{$self->get('details')} ) {
+      $seen{ $detail->[3] } = 1;
+    }
+    keys %seen;
+
+  }else{
+
+    map { $_->classnum }
+        qsearch({ table   => 'cust_bill_pkg_detail',
+                  hashref => { billpkgnum => $self->billpkgnum },
+                  select  => 'DISTINCT classnum',
+               });
+
+  }
+
+}
+
+=item cust_bill_pkg_display [ type => TYPE ]
+
+Returns an array of display information for the invoice line item optionally
+limited to 'TYPE'.
+
+=cut
+
+sub cust_bill_pkg_display {
+  my ( $self, %opt ) = @_;
+
+  my $default =
+    new FS::cust_bill_pkg_display { billpkgnum =>$self->billpkgnum };
+
+  return ( $default ) unless defined dbdef->table('cust_bill_pkg_display');#hmmm
+
+  my $type = $opt{type} if exists $opt{type};
+  my @result;
+
+  if ( $self->get('display') ) {
+    @result = grep { defined($type) ? ($type eq $_->type) : 1 }
+              @{ $self->get('display') };
+  } else {
+    my $hashref = { 'billpkgnum' => $self->billpkgnum };
+    $hashref->{type} = $type if defined($type);
+    
+    @result = qsearch ({ 'table'    => 'cust_bill_pkg_display',
+                         'hashref'  => { 'billpkgnum' => $self->billpkgnum },
+                         'order_by' => 'ORDER BY billpkgdisplaynum',
+                      });
+  }
+
+  push @result, $default unless ( scalar(@result) || $type );
+
+  @result;
+
+}
+
+# reserving this name for my friends FS::{tax_rate|cust_main_county}::taxline
+# and FS::cust_main::bill
+
+sub _cust_tax_exempt_pkg {
+  my ( $self ) = @_;
+
+  $self->{Hash}->{_cust_tax_exempt_pkg} or
+  $self->{Hash}->{_cust_tax_exempt_pkg} = [];
+
+}
+
+=item cust_bill_pkg_tax_Xlocation
+
+Returns the list of associated cust_bill_pkg_tax_location and/or
+cust_bill_pkg_tax_rate_location objects
+
+=cut
+
+sub cust_bill_pkg_tax_Xlocation {
+  my $self = shift;
+
+  my %hash = ( 'billpkgnum' => $self->billpkgnum );
+
+  (
+    qsearch ( 'cust_bill_pkg_tax_location', { %hash  } ),
+    qsearch ( 'cust_bill_pkg_tax_rate_location', { %hash } )
+  );
+
+}
+
+=item cust_bill_pkg_detail [ CLASSNUM ]
+
+Returns the list of associated cust_bill_pkg_detail objects
+The optional CLASSNUM argument will limit the details to the specified usage
+class.
+
+=cut
+
+sub cust_bill_pkg_detail {
+  my $self = shift;
+  my $classnum = shift || '';
+
+  my %hash = ( 'billpkgnum' => $self->billpkgnum );
+  $hash{classnum} = $classnum if $classnum;
+
+  qsearch ( 'cust_bill_pkg_detail', { %hash  } ),
+
+}
+
 =back
 
 =head1 BUGS