multiple payment options, RT#23741
[freeside.git] / FS / FS / cust_bill_pkg_detail.pm
1 package FS::cust_bill_pkg_detail;
2
3 use strict;
4 use vars qw( @ISA $me $DEBUG %GetInfoType );
5 use HTML::Entities;
6 use FS::Record qw( qsearch qsearchs dbdef dbh );
7 use FS::cust_bill_pkg;
8 use FS::usage_class;
9 use FS::Conf;
10
11 @ISA = qw(FS::Record);
12 $me = '[ FS::cust_bill_pkg_detail ]';
13 $DEBUG = 0;
14
15 =head1 NAME
16
17 FS::cust_bill_pkg_detail - Object methods for cust_bill_pkg_detail records
18
19 =head1 SYNOPSIS
20
21   use FS::cust_bill_pkg_detail;
22
23   $record = new FS::cust_bill_pkg_detail \%hash;
24   $record = new FS::cust_bill_pkg_detail { '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_detail object represents additional detail information for
37 an invoice line item (see L<FS::cust_bill_pkg>).  FS::cust_bill_pkg_detail
38 inherits from FS::Record.  The following fields are currently supported:
39
40 =over 4
41
42 =item detailnum - primary key
43
44 =item billpkgnum - link to cust_bill_pkg
45
46 =item amount - price of this line item detail
47
48 =item format - '' for straight text and 'C' for CSV in detail
49
50 =item classnum - link to usage_class
51
52 =item duration - granularized number of seconds for this call
53
54 =item regionname -
55
56 =item phonenum -
57
58 =item accountcode - accountcode
59
60 =item startdate - CDR startdate, if any
61
62 =item detail - detail description
63
64 =back
65
66 =head1 METHODS
67
68 =over 4
69
70 =item new HASHREF
71
72 Creates a new line item detail.  To add the line item detail to the database,
73 see L<"insert">.
74
75 Note that this stores the hash reference, not a distinct copy of the hash it
76 points to.  You can ask the object for a copy with the I<hash> method.
77
78 =cut
79
80 # the new method can be inherited from FS::Record, if a table method is defined
81
82 sub table { 'cust_bill_pkg_detail'; }
83
84 =item insert
85
86 Adds this record to the database.  If there is an error, returns the error,
87 otherwise returns false.
88
89 =cut
90
91 sub insert {
92   my $self = shift;
93   my $error = $self->SUPER::insert(@_);
94   return $error if $error;
95
96   # link CDRs
97   my $acctids = $self->get('acctid') or return '';
98   $acctids = [ $acctids ] unless ref $acctids;
99   foreach my $acctid ( @$acctids ) {
100     my $cdr = FS::cdr->by_key($acctid);
101     $cdr->set('detailnum', $self->detailnum);
102     $error = $cdr->replace;
103     # this should never happen
104     return "error linking CDR #$acctid: $error" if $error;
105   }
106   '';
107 }
108
109 =item delete
110
111 Delete this record from the database.
112
113 =cut
114
115 sub delete {
116   my $self = shift;
117   my $error = $self->SUPER::delete;
118   return $error if $error;
119   foreach my $cdr (qsearch('cdr', { detailnum => $self->detailnum })) {
120     $cdr->set('detailnum', '');
121     $error = $cdr->replace;
122     return "error unlinking CDR #" . $cdr->acctid . ": $error" if $error;
123   }
124 }
125
126 =item replace OLD_RECORD
127
128 Replaces the OLD_RECORD with this one in the database.  If there is an error,
129 returns the error, otherwise returns false.
130
131 =cut
132
133 # the replace method can be inherited from FS::Record (doesn't touch CDRs)
134
135 =item check
136
137 Checks all fields to make sure this is a valid line item detail.  If there is
138 an error, returns the error, otherwise returns false.  Called by the insert
139 and replace methods.
140
141 =cut
142
143 # the check method should currently be supplied - FS::Record contains some
144 # data checking routines
145
146 sub check {
147   my $self = shift;
148
149   my $conf = new FS::Conf;
150
151   my $phonenum = $self->phonenum;
152   my $phonenum_check_method;
153   if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) {
154     $phonenum =~ s/\W//g;
155     $phonenum_check_method = 'ut_alphan';
156   } else {
157     $phonenum =~ s/\D//g;
158     $phonenum_check_method = 'ut_numbern';
159   }
160   $self->phonenum($phonenum);
161
162   $self->ut_numbern('detailnum')
163     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
164     #|| $self->ut_moneyn('amount')
165     || $self->ut_floatn('amount')
166     || $self->ut_enum('format', [ '', 'C' ] )
167     || $self->ut_numbern('duration')
168     || $self->ut_textn('regionname')
169     || $self->ut_textn('accountcode')
170     || $self->ut_text('detail')
171     || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum')
172     || $self->$phonenum_check_method('phonenum')
173     || $self->ut_numbern('startdate')
174     || $self->SUPER::check
175     ;
176
177 }
178
179 =item formatted [ OPTION => VALUE ... ]
180
181 Returns detail information for the invoice line item detail formatted for
182 display.
183
184 Currently available options are: I<format> I<escape_function>
185
186 If I<format> is set to html or latex then the format is improved
187 for tabular appearance in those environments if possible.
188
189 If I<escape_function> is set then the format is processed by this
190 function before being returned.
191
192 DEPRECATED? (mostly unused, expensive)
193 If I<format_function> is set then the detail is handed to this callback
194 for processing.
195
196 =cut
197
198 #totally false laziness w/cust_bill_pkg->detail
199 sub formatted {
200   my ( $self, %opt ) = @_;
201   my $format = $opt{format} || '';
202   return () unless defined dbdef->table('cust_bill_pkg_detail');
203
204   eval "use Text::CSV_XS;";
205   die $@ if $@;
206   my $csv = new Text::CSV_XS;
207
208   my $escape_function = sub { shift };
209
210   $escape_function = \&encode_entities
211     if $format eq 'html';
212
213   $escape_function =
214     sub {
215       my $value = shift;
216       $value =~ s/([#\$%&~_\^{}])( )?/"\\$1". ( ( defined($2) && length($2) ) ? "\\$2" : '' )/ge;
217       $value =~ s/([<>])/\$$1\$/g;
218       $value;
219     }
220   if $format eq 'latex';
221
222   $escape_function = $opt{escape_function} if $opt{escape_function};
223
224   my $format_sub = sub { my $detail = shift;
225                          $csv->parse($detail) or return "can't parse $detail";
226                          join(' - ', map { &$escape_function($_) }
227                                      $csv->fields
228                              );
229                        };
230
231   $format_sub = sub { my $detail = shift;
232                       $csv->parse($detail) or return "can't parse $detail";
233                       join('</TD><TD>', map { &$escape_function($_) }
234                                         $csv->fields
235                           );
236                     }
237     if $format eq 'html';
238
239   $format_sub = sub { my $detail = shift;
240                       $csv->parse($detail) or return "can't parse $detail";
241                       #join(' & ', map { '\small{'. &$escape_function($_). '}' }                      #            $csv->fields );
242                       my $result = '';
243                       my $column = 1;
244                       foreach ($csv->fields) {
245                         $result .= ' & ' if $column > 1;
246                         if ($column > 6) {                     # KLUDGE ALERT!
247                           $result .= '\multicolumn{1}{l}{\scriptsize{'.
248                                      &$escape_function($_). '}}';
249                         }else{
250                           $result .= '\scriptsize{'.  &$escape_function($_). '}';
251                         }
252                         $column++;
253                       }
254                       $result;
255                     }
256     if $format eq 'latex';
257
258   $format_sub = $opt{format_function} if $opt{format_function};
259
260   $self->format eq 'C'
261     ? &{$format_sub}( $self->detail, $self )
262     : &{$escape_function}( $self->detail )
263   ;
264 }
265
266 =item cust_bill_pkg
267
268 Returns the L<FS::cust_bill_pkg> object (the invoice line item) that
269 this detail belongs to.
270
271 =cut
272
273 sub cust_bill_pkg {
274   my $self = shift;
275   my $billpkgnum = $self->billpkgnum or return '';
276   FS::cust_bill_pkg->by_key($billpkgnum);
277 }
278
279 # Used by FS::Upgrade to migrate to a new database schema
280 sub _upgrade_schema { # class method
281
282   my ($class, %opts) = @_;
283
284   warn "$me upgrading $class\n" if $DEBUG;
285
286   my $classnum = dbdef->table($class->table)->column('classnum')
287     or return;
288
289   my $type = $classnum->type;
290   unless ( $type =~ /^int/i || $type =~ /int$/i ) {
291
292     my $dbh = dbh;
293     if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
294
295       eval "use DBI::Const::GetInfoType;";
296       die $@ if $@;
297
298       my $major_version = 0;
299       $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
300         && ( $major_version = sprintf("%d", $1) );
301
302       if ( $major_version > 7 ) {
303
304         # ideally this would be supported in DBIx-DBSchema and friends
305
306         foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
307
308           warn "updating $table column classnum to integer\n" if $DEBUG;
309           my $sql = "ALTER TABLE $table ALTER classnum TYPE int USING ".
310             "int4(classnum)";
311           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
312           $sth->execute or die $sth->errstr;
313
314         }
315
316       } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {  # earlier?
317
318         # ideally this would be supported in DBIx-DBSchema and friends
319
320         #  XXX_FIXME better locking
321
322         foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
323
324           warn "updating $table column classnum to integer\n" if $DEBUG;
325
326           my $sql = "ALTER TABLE $table RENAME classnum TO old_classnum";
327           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
328           $sth->execute or die $sth->errstr;
329
330           my $def = dbdef->table($table)->column('classnum');
331           $def->type('integer');
332           $def->length(''); 
333           $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
334           $sth = $dbh->prepare($sql) or die $dbh->errstr;
335           $sth->execute or die $sth->errstr;
336
337           $sql = "UPDATE $table SET classnum = int4( text( old_classnum ) )";
338           $sth = $dbh->prepare($sql) or die $dbh->errstr;
339           $sth->execute or die $sth->errstr;
340
341           $sql = "ALTER TABLE $table DROP old_classnum";
342           $sth = $dbh->prepare($sql) or die $dbh->errstr;
343           $sth->execute or die $sth->errstr;
344
345         }
346
347       } else {
348
349         die "cust_bill_pkg_detail classnum upgrade unsupported for this Pg version\n";
350
351       }
352
353     } else {
354
355       die "cust_bill_pkg_detail classnum upgrade only supported for Pg 8+\n";
356
357     }
358
359   }
360
361 }
362
363 # Used by FS::Upgrade to migrate to a new database
364 sub _upgrade_data { # class method
365
366   my ($class, %opts) = @_;
367
368   warn "$me Checking for unmigrated invoice line item details\n" if $DEBUG;
369
370   my @cbpd = qsearch({ 'table'   => $class->table,
371                        'hashref' => {},
372                        'extra_sql' => 'WHERE invnum IS NOT NULL AND '.
373                                       'pkgnum IS NOT NULL',
374                     });
375
376   if (scalar(@cbpd)) {
377     warn "$me Found unmigrated invoice line item details\n" if $DEBUG;
378
379     foreach my $cbpd ( @cbpd ) {
380       my $detailnum = $cbpd->detailnum;
381       warn "$me Contemplating detail $detailnum\n" if $DEBUG > 1;
382       my $cust_bill_pkg =
383         qsearchs({ 'table' => 'cust_bill_pkg',
384                    'hashref' => { 'invnum' => $cbpd->invnum,
385                                   'pkgnum' => $cbpd->pkgnum,
386                                 },
387                    'order_by' => 'ORDER BY billpkgnum LIMIT 1',
388                 });
389       if ($cust_bill_pkg) {
390         $cbpd->billpkgnum($cust_bill_pkg->billpkgnum);
391         $cbpd->invnum('');
392         $cbpd->pkgnum('');
393         my $error = $cbpd->replace;
394
395         warn "*** WARNING: error replacing line item detail ".
396              "(cust_bill_pkg_detail) $detailnum: $error ***\n"
397           if $error;
398       } else {
399         warn "Found orphaned line item detail $detailnum during upgrade.\n";
400       }
401
402     } # foreach $cbpd
403
404   } # if @cbpd
405
406   '';
407
408 }                         
409
410 =back
411
412 =head1 BUGS
413
414 =head1 SEE ALSO
415
416 L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation.
417
418 =cut
419
420 1;
421