FS/FS/TemplateItem_Mixin.pm

   1 package FS::TemplateItem_Mixin;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me ); # but NOT $conf
   5 use Carp;
   6 use FS::UID;
   7 use FS::Record qw( qsearch qsearchs dbh );
   8 use FS::part_pkg;
   9 use FS::cust_pkg;
  10
  11 $DEBUG = 0;
  12 $me = '[FS::TemplateItem_Mixin]';
  13
  14 =item cust_pkg
  15
  16 Returns the package (see L<FS::cust_pkg>) for this invoice line item.
  17
  18 =cut
  19
  20 sub cust_pkg {
  21   my $self = shift;
  22   carp "$me $self -> cust_pkg" if $DEBUG;
  23   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
  24 }
  25
  26 =item part_pkg
  27
  28 Returns the package definition for this invoice line item.
  29
  30 =cut
  31
  32 sub part_pkg {
  33   my $self = shift;
  34   if ( $self->pkgpart_override ) {
  35     qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart_override } );
  36   } else {
  37     my $part_pkg;
  38     my $cust_pkg = $self->cust_pkg;
  39     $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
  40     $part_pkg;
  41   }
  42
  43 }
  44
  45 =item desc
  46
  47 Returns a description for this line item.  For typical line items, this is the
  48 I<pkg> field of the corresponding B<FS::part_pkg> object (see L<FS::part_pkg>).
  49 For one-shot line items and named taxes, it is the I<itemdesc> field of this
  50 line item, and for generic taxes, simply returns "Tax".
  51
  52 =cut
  53
  54 sub desc {
  55   my $self = shift;
  56
  57   if ( $self->pkgnum > 0 ) {
  58     $self->itemdesc || $self->part_pkg->pkg;
  59   } else {
  60     my $desc = $self->itemdesc || 'Tax';
  61     $desc .= ' '. $self->itemcomment if $self->itemcomment =~ /\S/;
  62     $desc;
  63   }
  64 }
  65
  66 =item details [ OPTION => VALUE ... ]
  67
  68 Returns an array of detail information for the invoice line item.
  69
  70 Currently available options are: I<format>, I<escape_function> and
  71 I<format_function>.
  72
  73 If I<format> is set to html or latex then the array members are improved
  74 for tabular appearance in those environments if possible.
  75
  76 If I<escape_function> is set then the array members are processed by this
  77 function before being returned.
  78
  79 I<format_function> overrides the normal HTML or LaTeX function for returning
  80 formatted CDRs.  It can be set to a subroutine which returns an empty list
  81 to skip usage detail:
  82
  83   'format_function' => sub { () },
  84
  85 =cut
  86
  87 sub details {
  88   my ( $self, %opt ) = @_;
  89   my $escape_function = $opt{escape_function} || sub { shift };
  90
  91   my $csv = new Text::CSV_XS;
  92
  93   if ( $opt{format_function} ) {
  94
  95     #this still expects to be passed a cust_bill_pkg_detail object as the
  96     #second argument, which is expensive
  97     carp "deprecated format_function passed to cust_bill_pkg->details";
  98     my $format_sub = $opt{format_function} if $opt{format_function};
  99
 100     map { ( $_->format eq 'C'
 101               ? &{$format_sub}( $_->detail, $_ )
 102               : &{$escape_function}( $_->detail )
 103           )
 104         }
 105       qsearch ({ 'table'    => $self->detail_table,
 106                  'hashref'  => { 'billpkgnum' => $self->billpkgnum },
 107                  'order_by' => 'ORDER BY detailnum',
 108               });
 109
 110   } elsif ( $opt{'no_usage'} ) {
 111
 112     my $sql = "SELECT detail FROM ". $self->detail_table.
 113               "  WHERE billpkgnum = ". $self->billpkgnum.
 114               "    AND ( format IS NULL OR format != 'C' ) ".
 115               "  ORDER BY detailnum";
 116     my $sth = dbh->prepare($sql) or die dbh->errstr;
 117     $sth->execute or die $sth->errstr;
 118
 119     map &{$escape_function}( $_->[0] ), @{ $sth->fetchall_arrayref };
 120
 121   } else {
 122
 123     my $format_sub;
 124     my $format = $opt{format} || '';
 125     if ( $format eq 'html' ) {
 126
 127       $format_sub = sub { my $detail = shift;
 128                           $csv->parse($detail) or return "can't parse $detail";
 129                           join('</TD><TD>', map { &$escape_function($_) }
 130                                             $csv->fields
 131                               );
 132                         };
 133
 134     } elsif ( $format eq 'latex' ) {
 135
 136       $format_sub = sub {
 137         my $detail = shift;
 138         $csv->parse($detail) or return "can't parse $detail";
 139         #join(' & ', map { '\small{'. &$escape_function($_). '}' }
 140         #            $csv->fields );
 141         my $result = '';
 142         my $column = 1;
 143         foreach ($csv->fields) {
 144           $result .= ' & ' if $column > 1;
 145           if ($column > 6) {                     # KLUDGE ALERT!
 146             $result .= '\multicolumn{1}{l}{\scriptsize{'.
 147                        &$escape_function($_). '}}';
 148           }else{
 149             $result .= '\scriptsize{'.  &$escape_function($_). '}';
 150           }
 151           $column++;
 152         }
 153         $result;
 154       };
 155
 156     } else {
 157
 158       $format_sub = sub { my $detail = shift;
 159                           $csv->parse($detail) or return "can't parse $detail";
 160                           join(' - ', map { &$escape_function($_) }
 161                                       $csv->fields
 162                               );
 163                         };
 164
 165     }
 166
 167     my $sql = "SELECT format, detail FROM ". $self->detail_table.
 168               "  WHERE billpkgnum = ". $self->billpkgnum.
 169               "  ORDER BY detailnum";
 170     my $sth = dbh->prepare($sql) or die dbh->errstr;
 171     $sth->execute or die $sth->errstr;
 172
 173     #avoid the fetchall_arrayref and loop for less memory usage?
 174
 175     map { (defined($_->[0]) && $_->[0] eq 'C')
 176             ? &{$format_sub}(      $_->[1] )
 177             : &{$escape_function}( $_->[1] );
 178         }
 179       @{ $sth->fetchall_arrayref };
 180
 181   }
 182
 183 }
 184
 185 =item details_header [ OPTION => VALUE ... ]
 186
 187 Returns a list representing an invoice line item detail header, if any.
 188 This relies on the behavior of voip_cdr in that it expects the header
 189 to be the first CSV formatted detail (as is expected by invoice generation
 190 routines).  Returns the empty list otherwise.
 191
 192 =cut
 193
 194 sub details_header {
 195   my $self = shift;
 196
 197   my $csv = new Text::CSV_XS;
 198
 199   my @detail =
 200     qsearch ({ 'table'    => $self->detail_table,
 201                'hashref'  => { 'billpkgnum' => $self->billpkgnum,
 202                                'format'     => 'C',
 203                              },
 204                'order_by' => 'ORDER BY detailnum LIMIT 1',
 205             });
 206   return() unless scalar(@detail);
 207   $csv->parse($detail[0]->detail) or return ();
 208   $csv->fields;
 209 }
 210
 211 =item quantity
 212
 213 =cut
 214
 215 sub quantity {
 216   my( $self, $value ) = @_;
 217   if ( defined($value) ) {
 218     $self->setfield('quantity', $value);
 219   }
 220   $self->getfield('quantity') || 1;
 221 }
 222
 223 =item unitsetup
 224
 225 =cut
 226
 227 sub unitsetup {
 228   my( $self, $value ) = @_;
 229   if ( defined($value) ) {
 230     $self->setfield('unitsetup', $value);
 231   }
 232   $self->getfield('unitsetup') eq ''
 233     ? $self->getfield('setup')
 234     : $self->getfield('unitsetup');
 235 }
 236
 237 =item unitrecur
 238
 239 =cut
 240
 241 sub unitrecur {
 242   my( $self, $value ) = @_;
 243   if ( defined($value) ) {
 244     $self->setfield('unitrecur', $value);
 245   }
 246   $self->getfield('unitrecur') eq ''
 247     ? $self->getfield('recur')
 248     : $self->getfield('unitrecur');
 249 }
 250
 251 =item cust_bill_pkg_display [ type => TYPE ]
 252
 253 Returns an array of display information for the invoice line item optionally
 254 limited to 'TYPE'.
 255
 256 =cut
 257
 258 sub cust_bill_pkg_display {
 259   my ( $self, %opt ) = @_;
 260
 261   my $class = 'FS::'. $self->display_table;
 262
 263   my $default = $class->new( { billpkgnum =>$self->billpkgnum } );
 264
 265   my $type = $opt{type} if exists $opt{type};
 266   my @result;
 267
 268   if ( $self->get('display') ) {
 269     @result = grep { defined($type) ? ($type eq $_->type) : 1 }
 270               @{ $self->get('display') };
 271   } else {
 272     my $hashref = { 'billpkgnum' => $self->billpkgnum };
 273     $hashref->{type} = $type if defined($type);
 274
 275     my $order_by = $self->display_table_orderby || 'billpkgdisplaynum';
 276
 277     @result = qsearch ({ 'table'    => $self->display_table,
 278                          'hashref'  => $hashref,
 279                          'order_by' => "ORDER BY $order_by",
 280                       });
 281   }
 282
 283   push @result, $default unless ( scalar(@result) || $type );
 284
 285   @result;
 286
 287 }
 288
 289 =item cust_bill_pkg_detail [ CLASSNUM ]
 290
 291 Returns the list of associated cust_bill_pkg_detail objects
 292 The optional CLASSNUM argument will limit the details to the specified usage
 293 class.
 294
 295 =cut
 296
 297 sub cust_bill_pkg_detail {
 298   my $self = shift;
 299   my $classnum = shift || '';
 300
 301   my %hash = ( 'billpkgnum' => $self->billpkgnum );
 302   $hash{classnum} = $classnum if $classnum;
 303
 304   qsearch( $self->detail_table, \%hash ),
 305
 306 }
 307
 308 =item cust_bill_pkg_discount
 309
 310 Returns the list of associated cust_bill_pkg_discount objects.
 311
 312 =cut
 313
 314 sub cust_bill_pkg_discount {
 315   my $self = shift;
 316   qsearch( $self->discount_table, { 'billpkgnum' => $self->billpkgnum } );
 317 }
 318
 319 1;