FS/FS/cust_bill_pkg.pm

   1 package FS::cust_bill_pkg;
   2
   3 use strict;
   4 use vars qw( @ISA );
   5 use FS::Record qw( qsearch qsearchs dbdef dbh );
   6 use FS::cust_main_Mixin;
   7 use FS::cust_pkg;
   8 use FS::cust_bill;
   9 use FS::cust_bill_pkg_detail;
  10 use FS::cust_bill_pay_pkg;
  11 use FS::cust_credit_bill_pkg;
  12
  13 @ISA = qw( FS::cust_main_Mixin FS::Record );
  14
  15 =head1 NAME
  16
  17 FS::cust_bill_pkg - Object methods for cust_bill_pkg records
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::cust_bill_pkg;
  22
  23   $record = new FS::cust_bill_pkg \%hash;
  24   $record = new FS::cust_bill_pkg { 'column' => 'value' };
  25
  26   $error = $record->insert;
  27
  28   $error = $new_record->replace($old_record);
  29
  30   $error = $record->delete;
  31
  32   $error = $record->check;
  33
  34 =head1 DESCRIPTION
  35
  36 An FS::cust_bill_pkg object represents an invoice line item.
  37 FS::cust_bill_pkg inherits from FS::Record.  The following fields are currently
  38 supported:
  39
  40 =over 4
  41
  42 =item billpkgnum - primary key
  43
  44 =item invnum - invoice (see L<FS::cust_bill>)
  45
  46 =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)
  47
  48 =item setup - setup fee
  49
  50 =item recur - recurring fee
  51
  52 =item sdate - starting date of recurring fee
  53
  54 =item edate - ending date of recurring fee
  55
  56 =item itemdesc - Line item description (currentlty used only when pkgnum is 0 or -1)
  57
  58 =item quantity - If not set, defaults to 1
  59
  60 =item unitsetup - If not set, defaults to setup
  61
  62 =item unitrecur - If not set, defaults to recur
  63
  64 =back
  65
  66 sdate and edate are specified as UNIX timestamps; see L<perlfunc/"time">.  Also
  67 see L<Time::Local> and L<Date::Parse> for conversion functions.
  68
  69 =head1 METHODS
  70
  71 =over 4
  72
  73 =item new HASHREF
  74
  75 Creates a new line item.  To add the line item to the database, see
  76 L<"insert">.  Line items are normally created by calling the bill method of a
  77 customer object (see L<FS::cust_main>).
  78
  79 =cut
  80
  81 sub table { 'cust_bill_pkg'; }
  82
  83 =item insert
  84
  85 Adds this line item to the database.  If there is an error, returns the error,
  86 otherwise returns false.
  87
  88 =cut
  89
  90 sub insert {
  91   my $self = shift;
  92
  93   local $SIG{HUP} = 'IGNORE';
  94   local $SIG{INT} = 'IGNORE';
  95   local $SIG{QUIT} = 'IGNORE';
  96   local $SIG{TERM} = 'IGNORE';
  97   local $SIG{TSTP} = 'IGNORE';
  98   local $SIG{PIPE} = 'IGNORE';
  99
 100   my $oldAutoCommit = $FS::UID::AutoCommit;
 101   local $FS::UID::AutoCommit = 0;
 102   my $dbh = dbh;
 103
 104   my $error = $self->SUPER::insert;
 105   if ( $error ) {
 106     $dbh->rollback if $oldAutoCommit;
 107     return $error;
 108   }
 109
 110   unless ( defined dbdef->table('cust_bill_pkg_detail') && $self->get('details') ) {
 111     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 112     return '';
 113   }
 114
 115   foreach my $detail ( @{$self->get('details')} ) {
 116     my $cust_bill_pkg_detail = new FS::cust_bill_pkg_detail {
 117       'pkgnum' => $self->pkgnum,
 118       'invnum' => $self->invnum,
 119       'format' => (ref($detail) ? $detail->[0] : '' ),
 120       'detail' => (ref($detail) ? $detail->[1] : $detail ),
 121     };
 122     $error = $cust_bill_pkg_detail->insert;
 123     if ( $error ) {
 124       $dbh->rollback if $oldAutoCommit;
 125       return $error;
 126     }
 127   }
 128
 129   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 130   '';
 131
 132 }
 133
 134 =item delete
 135
 136 Currently unimplemented.  I don't remove line items because there would then be
 137 no record the items ever existed (which is bad, no?)
 138
 139 =cut
 140
 141 sub delete {
 142   return "Can't delete cust_bill_pkg records!";
 143 }
 144
 145 =item replace OLD_RECORD
 146
 147 Currently unimplemented.  This would be even more of an accounting nightmare
 148 than deleteing the items.  Just don't do it.
 149
 150 =cut
 151
 152 sub replace {
 153   return "Can't modify cust_bill_pkg records!";
 154 }
 155
 156 =item check
 157
 158 Checks all fields to make sure this is a valid line item.  If there is an
 159 error, returns the error, otherwise returns false.  Called by the insert
 160 method.
 161
 162 =cut
 163
 164 sub check {
 165   my $self = shift;
 166
 167   my $error =
 168          $self->ut_numbern('billpkgnum')
 169       || $self->ut_snumber('pkgnum')
 170       || $self->ut_number('invnum')
 171       || $self->ut_money('setup')
 172       || $self->ut_money('recur')
 173       || $self->ut_numbern('sdate')
 174       || $self->ut_numbern('edate')
 175       || $self->ut_textn('itemdesc')
 176   ;
 177   return $error if $error;
 178
 179   #if ( $self->pkgnum != 0 ) { #allow unchecked pkgnum 0 for tax! (add to part_pkg?)
 180   if ( $self->pkgnum > 0 ) { #allow -1 for non-pkg line items and 0 for tax (add to part_pkg?)
 181     return "Unknown pkgnum ". $self->pkgnum
 182       unless qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 183   }
 184
 185   return "Unknown invnum"
 186     unless qsearchs( 'cust_bill' ,{ 'invnum' => $self->invnum } );
 187
 188   $self->SUPER::check;
 189 }
 190
 191 =item cust_pkg
 192
 193 Returns the package (see L<FS::cust_pkg>) for this invoice line item.
 194
 195 =cut
 196
 197 sub cust_pkg {
 198   my $self = shift;
 199   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 200 }
 201
 202 =item cust_bill
 203
 204 Returns the invoice (see L<FS::cust_bill>) for this invoice line item.
 205
 206 =cut
 207
 208 sub cust_bill {
 209   my $self = shift;
 210   qsearchs( 'cust_bill', { 'invnum' => $self->invnum } );
 211 }
 212
 213 =item details [ OPTION => VALUE ... ]
 214
 215 Returns an array of detail information for the invoice line item.
 216
 217 Currently available options are: I<format> I<escape_function>
 218
 219 If I<format> is set to html or latex then the array members are improved
 220 for tabular appearance in those environments if possible.
 221
 222 If I<escape_function> is set then the array members are processed by this
 223 function before being returned.
 224
 225 =cut
 226
 227 sub details {
 228   my ( $self, %opt ) = @_;
 229   my $format = $opt{format} || '';
 230   my $escape_function = $opt{escape_function} || sub { shift };
 231   return () unless defined dbdef->table('cust_bill_pkg_detail');
 232
 233   eval "use Text::CSV_XS;";
 234   die $@ if $@;
 235   my $csv = new Text::CSV_XS;
 236
 237   my $format_sub = sub { my $detail = shift;
 238                          $csv->parse($detail) or return "can't parse $detail";
 239                          join(' - ', map { &$escape_function($_) }
 240                                      $csv->fields
 241                              );
 242                        };
 243
 244   $format_sub = sub { my $detail = shift;
 245                       $csv->parse($detail) or return "can't parse $detail";
 246                       join('</TD><TD>', map { &$escape_function($_) }
 247                                         $csv->fields
 248                           );
 249                     }
 250     if $format eq 'html';
 251
 252   $format_sub = sub { my $detail = shift;
 253                       $csv->parse($detail) or return "can't parse $detail";
 254                       #join(' & ', map { '\small{'. &$escape_function($_). '}' }
 255                       #            $csv->fields );
 256                       my $result = '';
 257                       my $column = 1;
 258                       foreach ($csv->fields) {
 259                         $result .= ' & ' if $column > 1;
 260                         if ($column > 6) {                     # KLUDGE ALERT!
 261                           $result .= '\multicolumn{1}{l}{\small{'.
 262                                      &$escape_function($_). '}}';
 263                         }else{
 264                           $result .= '\small{'.  &$escape_function($_). '}';
 265                         }
 266                         $column++;
 267                       }
 268                       $result;
 269                     }
 270     if $format eq 'latex';
 271
 272   map { ( $_->format eq 'C'
 273           ? &{$format_sub}( $_->detail )
 274           : &{$escape_function}( $_->detail )
 275         )
 276       }
 277     qsearch ({ 'table'    => 'cust_bill_pkg_detail',
 278                'hashref'  => { 'pkgnum' => $self->pkgnum,
 279                                'invnum' => $self->invnum,
 280                              },
 281                'order_by' => 'ORDER BY detailnum',
 282             });
 283     #qsearch ( 'cust_bill_pkg_detail', { 'lineitemnum' => $self->lineitemnum });
 284 }
 285
 286 =item desc
 287
 288 Returns a description for this line item.  For typical line items, this is the
 289 I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>).
 290 For one-shot line items and named taxes, it is the I<itemdesc> field of this
 291 line item, and for generic taxes, simply returns "Tax".
 292
 293 =cut
 294
 295 sub desc {
 296   my $self = shift;
 297
 298   if ( $self->pkgnum > 0 ) {
 299     $self->cust_pkg->part_pkg->pkg;
 300   } else {
 301     $self->itemdesc || 'Tax';
 302   }
 303 }
 304
 305 =item owed_setup
 306
 307 Returns the amount owed (still outstanding) on this line item's setup fee,
 308 which is the amount of the line item minus all payment applications (see
 309 L<FS::cust_bill_pay_pkg> and credit applications (see
 310 L<FS::cust_credit_bill_pkg>).
 311
 312 =cut
 313
 314 sub owed_setup {
 315   my $self = shift;
 316   $self->owed('setup', @_);
 317 }
 318
 319 =item owed_recur
 320
 321 Returns the amount owed (still outstanding) on this line item's recurring fee,
 322 which is the amount of the line item minus all payment applications (see
 323 L<FS::cust_bill_pay_pkg> and credit applications (see
 324 L<FS::cust_credit_bill_pkg>).
 325
 326 =cut
 327
 328 sub owed_recur {
 329   my $self = shift;
 330   $self->owed('recur', @_);
 331 }
 332
 333 # modeled after cust_bill::owed...
 334 sub owed {
 335   my( $self, $field ) = @_;
 336   my $balance = $self->$field();
 337   $balance -= $_->amount foreach ( $self->cust_bill_pay_pkg($field) );
 338   $balance -= $_->amount foreach ( $self->cust_credit_bill_pkg($field) );
 339   $balance = sprintf( '%.2f', $balance );
 340   $balance =~ s/^\-0\.00$/0.00/; #yay ieee fp
 341   $balance;
 342 }
 343
 344 sub cust_bill_pay_pkg {
 345   my( $self, $field ) = @_;
 346   qsearch( 'cust_bill_pay_pkg', { 'billpkgnum' => $self->billpkgnum,
 347                                   'setuprecur' => $field,
 348                                 }
 349          );
 350 }
 351
 352 sub cust_credit_bill_pkg {
 353   my( $self, $field ) = @_;
 354   qsearch( 'cust_credit_bill_pkg', { 'billpkgnum' => $self->billpkgnum,
 355                                      'setuprecur' => $field,
 356                                    }
 357          );
 358 }
 359
 360 =item quantity
 361
 362 =cut
 363
 364 sub quantity {
 365   my( $self, $value ) = @_;
 366   if ( defined($value) ) {
 367     $self->setfield('quantity', $value);
 368   }
 369   $self->getfield('quantity') || 1;
 370 }
 371
 372 =item unitsetup
 373
 374 =cut
 375
 376 sub unitsetup {
 377   my( $self, $value ) = @_;
 378   if ( defined($value) ) {
 379     $self->setfield('unitsetup', $value);
 380   }
 381   $self->getfield('unitsetup') eq ''
 382     ? $self->getfield('setup')
 383     : $self->getfield('unitsetup');
 384 }
 385
 386 =item unitrecur
 387
 388 =cut
 389
 390 sub unitrecur {
 391   my( $self, $value ) = @_;
 392   if ( defined($value) ) {
 393     $self->setfield('unitrecur', $value);
 394   }
 395   $self->getfield('unitrecur') eq ''
 396     ? $self->getfield('recur')
 397     : $self->getfield('unitrecur');
 398 }
 399
 400 =back
 401
 402 =head1 BUGS
 403
 404 setup and recur shouldn't be separate fields.  There should be one "amount"
 405 field and a flag to tell you if it is a setup/one-time fee or a recurring fee.
 406
 407 A line item with both should really be two separate records (preserving
 408 sdate and edate for setup fees for recurring packages - that information may
 409 be valuable later).  Invoice generation (cust_main::bill), invoice printing
 410 (cust_bill), tax reports (report_tax.cgi) and line item reports
 411 (cust_bill_pkg.cgi) would need to be updated.
 412
 413 owed_setup and owed_recur could then be repaced by just owed, and
 414 cust_bill::open_cust_bill_pkg and
 415 cust_bill_ApplicationCommon::apply_to_lineitems could be simplified.
 416
 417 =head1 SEE ALSO
 418
 419 L<FS::Record>, L<FS::cust_bill>, L<FS::cust_pkg>, L<FS::cust_main>, schema.html
 420 from the base documentation.
 421
 422 =cut
 423
 424 1;
 425