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