clarify descriptions of various ways to skip CDRs
[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 # the insert method can be inherited from FS::Record
92
93 =item delete
94
95 Delete this record from the database.
96
97 =cut
98
99 # the delete method can be inherited from FS::Record
100
101 =item replace OLD_RECORD
102
103 Replaces the OLD_RECORD with this one in the database.  If there is an error,
104 returns the error, otherwise returns false.
105
106 =cut
107
108 # the replace method can be inherited from FS::Record
109
110 =item check
111
112 Checks all fields to make sure this is a valid line item detail.  If there is
113 an error, returns the error, otherwise returns false.  Called by the insert
114 and replace methods.
115
116 =cut
117
118 # the check method should currently be supplied - FS::Record contains some
119 # data checking routines
120
121 sub check {
122   my $self = shift;
123
124   my $conf = new FS::Conf;
125
126   my $phonenum = $self->phonenum;
127   my $phonenum_check_method;
128   if ( $conf->exists('svc_phone-allow_alpha_phonenum') ) {
129     $phonenum =~ s/\W//g;
130     $phonenum_check_method = 'ut_alphan';
131   } else {
132     $phonenum =~ s/\D//g;
133     $phonenum_check_method = 'ut_numbern';
134   }
135   $self->phonenum($phonenum);
136
137   $self->ut_numbern('detailnum')
138     || $self->ut_foreign_key('billpkgnum', 'cust_bill_pkg', 'billpkgnum')
139     #|| $self->ut_moneyn('amount')
140     || $self->ut_floatn('amount')
141     || $self->ut_enum('format', [ '', 'C' ] )
142     || $self->ut_numbern('duration')
143     || $self->ut_textn('regionname')
144     || $self->ut_textn('accountcode')
145     || $self->ut_text('detail')
146     || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum')
147     || $self->$phonenum_check_method('phonenum')
148     || $self->SUPER::check
149     ;
150
151 }
152
153 =item formatted [ OPTION => VALUE ... ]
154
155 Returns detail information for the invoice line item detail formatted for
156 display.
157
158 Currently available options are: I<format> I<escape_function>
159
160 If I<format> is set to html or latex then the format is improved
161 for tabular appearance in those environments if possible.
162
163 If I<escape_function> is set then the format is processed by this
164 function before being returned.
165
166 If I<format_function> is set then the detail is handed to this callback
167 for processing.
168
169 =cut
170
171 sub formatted {
172   my ( $self, %opt ) = @_;
173   my $format = $opt{format} || '';
174   return () unless defined dbdef->table('cust_bill_pkg_detail');
175
176   eval "use Text::CSV_XS;";
177   die $@ if $@;
178   my $csv = new Text::CSV_XS;
179
180   my $escape_function = sub { shift };
181
182   $escape_function = \&encode_entities
183     if $format eq 'html';
184
185   $escape_function =
186     sub {
187       my $value = shift;
188       $value =~ s/([#\$%&~_\^{}])( )?/"\\$1". ( ( defined($2) && length($2) ) ? "\\$2" : '' )/ge;
189       $value =~ s/([<>])/\$$1\$/g;
190       $value;
191     }
192   if $format eq 'latex';
193
194   $escape_function = $opt{escape_function} if $opt{escape_function};
195
196   my $format_sub = sub { my $detail = shift;
197                          $csv->parse($detail) or return "can't parse $detail";
198                          join(' - ', map { &$escape_function($_) }
199                                      $csv->fields
200                              );
201                        };
202
203   $format_sub = sub { my $detail = shift;
204                       $csv->parse($detail) or return "can't parse $detail";
205                       join('</TD><TD>', map { &$escape_function($_) }
206                                         $csv->fields
207                           );
208                     }
209     if $format eq 'html';
210
211   $format_sub = sub { my $detail = shift;
212                       $csv->parse($detail) or return "can't parse $detail";
213                       #join(' & ', map { '\small{'. &$escape_function($_). '}' }                      #            $csv->fields );
214                       my $result = '';
215                       my $column = 1;
216                       foreach ($csv->fields) {
217                         $result .= ' & ' if $column > 1;
218                         if ($column > 6) {                     # KLUDGE ALERT!
219                           $result .= '\multicolumn{1}{l}{\scriptsize{'.
220                                      &$escape_function($_). '}}';
221                         }else{
222                           $result .= '\scriptsize{'.  &$escape_function($_). '}';
223                         }
224                         $column++;
225                       }
226                       $result;
227                     }
228     if $format eq 'latex';
229
230   $format_sub = $opt{format_function} if $opt{format_function};
231
232   $self->format eq 'C'
233     ? &{$format_sub}( $self->detail, $self )
234     : &{$escape_function}( $self->detail )
235   ;
236 }
237
238
239 # Used by FS::Upgrade to migrate to a new database schema
240 sub _upgrade_schema { # class method
241
242   my ($class, %opts) = @_;
243
244   warn "$me upgrading $class\n" if $DEBUG;
245
246   my $classnum = dbdef->table($class->table)->column('classnum')
247     or return;
248
249   my $type = $classnum->type;
250   unless ( $type =~ /^int/i || $type =~ /int$/i ) {
251
252     my $dbh = dbh;
253     if ( $dbh->{Driver}->{Name} eq 'Pg' ) {
254
255       eval "use DBI::Const::GetInfoType;";
256       die $@ if $@;
257
258       my $major_version = 0;
259       $dbh->get_info( $GetInfoType{SQL_DBMS_VER} ) =~ /^(\d{2})/
260         && ( $major_version = sprintf("%d", $1) );
261
262       if ( $major_version > 7 ) {
263
264         # ideally this would be supported in DBIx-DBSchema and friends
265
266         foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
267
268           warn "updating $table column classnum to integer\n" if $DEBUG;
269           my $sql = "ALTER TABLE $table ALTER classnum TYPE int USING ".
270             "int4(classnum)";
271           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
272           $sth->execute or die $sth->errstr;
273
274         }
275
276       } elsif ( $dbh->{pg_server_version} =~ /^704/ ) {  # earlier?
277
278         # ideally this would be supported in DBIx-DBSchema and friends
279
280         #  XXX_FIXME better locking
281
282         foreach my $table ( qw( cust_bill_pkg_detail h_cust_bill_pkg_detail ) ){
283
284           warn "updating $table column classnum to integer\n" if $DEBUG;
285
286           my $sql = "ALTER TABLE $table RENAME classnum TO old_classnum";
287           my $sth = $dbh->prepare($sql) or die $dbh->errstr;
288           $sth->execute or die $sth->errstr;
289
290           my $def = dbdef->table($table)->column('classnum');
291           $def->type('integer');
292           $def->length(''); 
293           $sql = "ALTER TABLE $table ADD COLUMN ". $def->line($dbh);
294           $sth = $dbh->prepare($sql) or die $dbh->errstr;
295           $sth->execute or die $sth->errstr;
296
297           $sql = "UPDATE $table SET classnum = int4( text( old_classnum ) )";
298           $sth = $dbh->prepare($sql) or die $dbh->errstr;
299           $sth->execute or die $sth->errstr;
300
301           $sql = "ALTER TABLE $table DROP old_classnum";
302           $sth = $dbh->prepare($sql) or die $dbh->errstr;
303           $sth->execute or die $sth->errstr;
304
305         }
306
307       } else {
308
309         die "cust_bill_pkg_detail classnum upgrade unsupported for this Pg version\n";
310
311       }
312
313     } else {
314
315       die "cust_bill_pkg_detail classnum upgrade only supported for Pg 8+\n";
316
317     }
318
319   }
320
321 }
322
323 # Used by FS::Upgrade to migrate to a new database
324 sub _upgrade_data { # class method
325
326   my ($class, %opts) = @_;
327
328   warn "$me Checking for unmigrated invoice line item details\n" if $DEBUG;
329
330   my @cbpd = qsearch({ 'table'   => $class->table,
331                        'hashref' => {},
332                        'extra_sql' => 'WHERE invnum IS NOT NULL AND '.
333                                       'pkgnum IS NOT NULL',
334                     });
335
336   if (scalar(@cbpd)) {
337     warn "$me Found unmigrated invoice line item details\n" if $DEBUG;
338
339     foreach my $cbpd ( @cbpd ) {
340       my $detailnum = $cbpd->detailnum;
341       warn "$me Contemplating detail $detailnum\n" if $DEBUG > 1;
342       my $cust_bill_pkg =
343         qsearchs({ 'table' => 'cust_bill_pkg',
344                    'hashref' => { 'invnum' => $cbpd->invnum,
345                                   'pkgnum' => $cbpd->pkgnum,
346                                 },
347                    'order_by' => 'ORDER BY billpkgnum LIMIT 1',
348                 });
349       if ($cust_bill_pkg) {
350         $cbpd->billpkgnum($cust_bill_pkg->billpkgnum);
351         $cbpd->invnum('');
352         $cbpd->pkgnum('');
353         my $error = $cbpd->replace;
354
355         warn "*** WARNING: error replacing line item detail ".
356              "(cust_bill_pkg_detail) $detailnum: $error ***\n"
357           if $error;
358       } else {
359         warn "Found orphaned line item detail $detailnum during upgrade.\n";
360       }
361
362     } # foreach $cbpd
363
364   } # if @cbpd
365
366   '';
367
368 }                         
369
370 =back
371
372 =head1 BUGS
373
374 =head1 SEE ALSO
375
376 L<FS::cust_bill_pkg>, L<FS::Record>, schema.html from the base documentation.
377
378 =cut
379
380 1;
381