cleanup
[freeside.git] / FS / FS / rate_detail.pm
1 package FS::rate_detail;
2
3 use strict;
4 use vars qw( @ISA $DEBUG $me );
5 use FS::Record qw( qsearch qsearchs dbh );
6 use FS::rate;
7 use FS::rate_region;
8 use FS::rate_time;
9 use Tie::IxHash;
10
11 @ISA = qw(FS::Record);
12
13 $DEBUG = 0;
14 $me = '[FS::rate_detail]';
15
16 =head1 NAME
17
18 FS::rate_detail - Object methods for rate_detail records
19
20 =head1 SYNOPSIS
21
22   use FS::rate_detail;
23
24   $record = new FS::rate_detail \%hash;
25   $record = new FS::rate_detail { 'column' => 'value' };
26
27   $error = $record->insert;
28
29   $error = $new_record->replace($old_record);
30
31   $error = $record->delete;
32
33   $error = $record->check;
34
35 =head1 DESCRIPTION
36
37 An FS::rate_detail object represents an call plan rate.  FS::rate_detail
38 inherits from FS::Record.  The following fields are currently supported:
39
40 =over 4
41
42 =item ratedetailnum - primary key
43
44 =item ratenum - rate plan (see L<FS::rate>)
45
46 =item orig_regionnum - call origination region
47
48 =item dest_regionnum - call destination region
49
50 =item min_included - included minutes
51
52 =item min_charge - charge per minute
53
54 =item sec_granularity - granularity in seconds, i.e. 6 or 60; 0 for per-call
55
56 =item classnum - usage class (see L<FS::usage_class>) if any for this rate
57
58 =item ratetimenum - rating time period (see L<FS::rate_time) if any
59
60 =item cdrtypenum - CDR type (see L<FS::cdr_type>) if any for this rate
61
62 =item region_group - Group in region group for rate plan
63
64 =back
65
66 =head1 METHODS
67
68 =over 4
69
70 =item new HASHREF
71
72 Creates a new call plan rate.  To add the call plan rate to the database, see
73 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 { 'rate_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 call plan rate.  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 $error = 
125        $self->ut_numbern('ratedetailnum')
126     || $self->ut_foreign_key('ratenum', 'rate', 'ratenum')
127     || $self->ut_foreign_keyn('orig_regionnum', 'rate_region', 'regionnum' )
128     || $self->ut_foreign_key('dest_regionnum', 'rate_region', 'regionnum' )
129     || $self->ut_number('min_included')
130
131     #|| $self->ut_money('min_charge')
132     #good enough for now...
133     || $self->ut_float('min_charge')
134
135     || $self->ut_number('sec_granularity')
136
137     || $self->ut_foreign_keyn('classnum', 'usage_class', 'classnum' )
138     || $self->ut_enum('region_group',    [ '', 'Y' ])
139   ;
140   return $error if $error;
141
142   $self->SUPER::check;
143 }
144
145 =item rate 
146
147 Returns the parent call plan (see L<FS::rate>) associated with this call plan
148 rate.
149
150 =cut
151
152 sub rate {
153   my $self = shift;
154   qsearchs('rate', { 'ratenum' => $self->ratenum } );
155 }
156
157 =item orig_region 
158
159 Returns the origination region (see L<FS::rate_region>) associated with this
160 call plan rate.
161
162 =cut
163
164 sub orig_region {
165   my $self = shift;
166   qsearchs('rate_region', { 'regionnum' => $self->orig_regionnum } );
167 }
168
169 =item dest_region 
170
171 Returns the destination region (see L<FS::rate_region>) associated with this
172 call plan rate.
173
174 =cut
175
176 sub dest_region {
177   my $self = shift;
178   qsearchs('rate_region', { 'regionnum' => $self->dest_regionnum } );
179 }
180
181 =item dest_regionname
182
183 Returns the name of the destination region (see L<FS::rate_region>) associated
184 with this call plan rate.
185
186 =cut
187
188 sub dest_regionname {
189   my $self = shift;
190   $self->dest_region->regionname;
191 }
192
193 =item dest_regionname
194
195 Returns a short list of the prefixes for the destination region
196 (see L<FS::rate_region>) associated with this call plan rate.
197
198 =cut
199
200 sub dest_prefixes_short {
201   my $self = shift;
202   $self->dest_region->prefixes_short;
203 }
204
205 =item rate_time
206
207 Returns the L<FS::rate_time> object associated with this call 
208 plan rate, if there is one.
209
210 =cut
211
212 sub rate_time {
213   my $self = shift;
214   $self->ratetimenum ? FS::rate_time->by_key($self->ratetimenum) : ();
215 }
216
217 =item rate_time_name
218
219 Returns the I<ratetimename> field of the L<FS::rate_time> object
220 associated with this rate plan.
221
222 =cut
223
224 sub rate_time_name {
225   my $self = shift;
226   $self->ratetimenum ? $self->rate_time->ratetimename : '(default)';
227 }
228
229 =item classname
230
231 Returns the name of the usage class (see L<FS::usage_class>) associated with
232 this call plan rate.
233
234 =cut
235
236 sub classname {
237   my $self = shift;
238   my $usage_class = qsearchs('usage_class', { classnum => $self->classnum });
239   $usage_class ? $usage_class->classname : '';
240 }
241
242 =item cdrtypename
243
244 Returns the name of the CDR type (see L<FS::cdr_type) associated with this 
245 rate, if there is one.  If not, returns the cdrtypenum itself.  This will 
246 only return an empty string if cdrtypenum is NULL.
247
248 =cut
249
250 sub cdrtypename {
251   my $self = shift;
252   my $cdrtypenum = $self->cdrtypenum or return '';
253   my $cdr_type = qsearchs('cdr_type', { cdrtypenum => $cdrtypenum });
254   return $cdr_type ? $cdr_type->cdrtypename : $cdrtypenum;
255 }
256
257 =back
258
259 =head1 SUBROUTINES
260
261 =over 4
262
263 =item granularities
264
265   Returns an (ordered) hash of granularity => name pairs
266
267 =cut
268
269 tie my %granularities, 'Tie::IxHash',
270   '1', => '1 second',
271   '6'  => '6 second',
272   '30' => '30 second', # '1/2 minute',
273   '60' => 'minute',
274   '0'  => 'call',
275 ;
276
277 sub granularities {
278   %granularities;
279 }
280
281 =item conn_secs
282
283   Returns an (ordered) hash of conn_sec => name pairs
284
285 =cut
286
287 tie my %conn_secs, 'Tie::IxHash',
288     '0' => 'connection',
289     '1' => 'first second',
290     '6' => 'first 6 seconds',
291    '30' => 'first 30 seconds', # '1/2 minute',
292    '60' => 'first minute',
293   '120' => 'first 2 minutes',
294   '180' => 'first 3 minutes',
295   '300' => 'first 5 minutes',
296 ;
297
298 sub conn_secs {
299   %conn_secs;
300 }
301
302 =item process_edit_import
303
304 =cut
305
306 use Storable qw(thaw);
307 use Data::Dumper;
308 use MIME::Base64;
309 sub process_edit_import {
310   my $job = shift;
311
312   #do we actually belong in rate_detail, like 'table' says?  even though we
313   # can possible create new rate records, that's a side effect, mostly we
314   # do edit rate_detail records in batch...
315
316   my $opt = { 'table'          => 'rate_detail',
317               'params'         => [], #required, apparantly
318               'formats'        => { 'default' => [
319                 'dest_regionnum',
320                 '', #regionname
321                 '', #country
322                 '', #prefixes
323                 #loop these
324                 'min_included',
325                 'min_charge',
326                 sub {
327                   my( $rate_detail, $g ) = @_;
328                   $g  = 0  if $g =~ /^\s*(per-)?call\s*$/i;
329                   $g  = 60 if $g =~ /^\s*minute\s*$/i;
330                   $g  =~ /^(\d+)/ or die "can't parse granularity: $g".
331                                          " for record ". Dumper($rate_detail);
332                   $rate_detail->sec_granularity($1);
333                 },
334                 'classnum',
335               ] },
336               'format_headers' => { 'default' => 1, },
337               'format_types'   => { 'default' => 'xls' },
338             };
339
340   #false laziness w/
341   #FS::Record::process_batch_import( $job, $opt, @_ );
342   
343   my $table = $opt->{table};
344   my @pass_params = @{ $opt->{params} };
345   my %formats = %{ $opt->{formats} };
346
347   my $param = thaw(decode_base64(shift));
348   warn Dumper($param) if $DEBUG;
349   
350   my $files = $param->{'uploaded_files'}
351     or die "No files provided.\n";
352
353   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
354
355   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
356   my $file = $dir. $files{'file'};
357
358   my $error =
359     #false laziness w/
360     #FS::Record::batch_import( {
361     FS::rate_detail::edit_import( {
362       #class-static
363       table                      => $table,
364       formats                    => \%formats,
365       format_types               => $opt->{format_types},
366       format_headers             => $opt->{format_headers},
367       format_sep_chars           => $opt->{format_sep_chars},
368       format_fixedlength_formats => $opt->{format_fixedlength_formats},
369       #per-import
370       job                        => $job,
371       file                       => $file,
372       #type                       => $type,
373       format                     => $param->{format},
374       params                     => { map { $_ => $param->{$_} } @pass_params },
375       #?
376       default_csv                => $opt->{default_csv},
377     } );
378
379   unlink $file;
380
381   die "$error\n" if $error;
382
383 }
384
385 =item edit_import
386
387 =cut
388
389 #false laziness w/ #FS::Record::batch_import, grep "edit_import" for differences
390 #could be turned into callbacks or something
391 use Text::CSV_XS;
392 sub edit_import {
393   my $param = shift;
394
395   warn "$me edit_import call with params: \n". Dumper($param)
396     if $DEBUG;
397
398   my $table   = $param->{table};
399   my $formats = $param->{formats};
400
401   my $job     = $param->{job};
402   my $file    = $param->{file};
403   my $format  = $param->{'format'};
404   my $params  = $param->{params} || {};
405
406   die "unknown format $format" unless exists $formats->{ $format };
407
408   my $type = $param->{'format_types'}
409              ? $param->{'format_types'}{ $format }
410              : $param->{type} || 'csv';
411
412   unless ( $type ) {
413     if ( $file =~ /\.(\w+)$/i ) {
414       $type = lc($1);
415     } else {
416       #or error out???
417       warn "can't parse file type from filename $file; defaulting to CSV";
418       $type = 'csv';
419     }
420     $type = 'csv'
421       if $param->{'default_csv'} && $type ne 'xls';
422   }
423
424   my $header = $param->{'format_headers'}
425                  ? $param->{'format_headers'}{ $param->{'format'} }
426                  : 0;
427
428   my $sep_char = $param->{'format_sep_chars'}
429                    ? $param->{'format_sep_chars'}{ $param->{'format'} }
430                    : ',';
431
432   my $fixedlength_format =
433     $param->{'format_fixedlength_formats'}
434       ? $param->{'format_fixedlength_formats'}{ $param->{'format'} }
435       : '';
436
437   my @fields = @{ $formats->{ $format } };
438
439   my $row = 0;
440   my $count;
441   my $parser;
442   my @buffer = ();
443   my @header = (); #edit_import
444   if ( $type eq 'csv' || $type eq 'fixedlength' ) {
445
446     if ( $type eq 'csv' ) {
447
448       my %attr = ();
449       $attr{sep_char} = $sep_char if $sep_char;
450       $parser = new Text::CSV_XS \%attr;
451
452     } elsif ( $type eq 'fixedlength' ) {
453
454       eval "use Parse::FixedLength;";
455       die $@ if $@;
456       $parser = new Parse::FixedLength $fixedlength_format;
457  
458     } else {
459       die "Unknown file type $type\n";
460     }
461
462     @buffer = split(/\r?\n/, slurp($file) );
463     splice(@buffer, 0, ($header || 0) );
464     $count = scalar(@buffer);
465
466   } elsif ( $type eq 'xls' ) {
467
468     eval "use Spreadsheet::ParseExcel;";
469     die $@ if $@;
470
471     eval "use DateTime::Format::Excel;";
472     #for now, just let the error be thrown if it is used, since only CDR
473     # formats bill_west and troop use it, not other excel-parsing things
474     #die $@ if $@;
475
476     my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($file);
477
478     $parser = $excel->{Worksheet}[0]; #first sheet
479
480     $count = $parser->{MaxRow} || $parser->{MinRow};
481     $count++;
482
483     $row = $header || 0;
484
485     #edit_import - need some magic to parse the header
486     if ( $header ) {
487       my @header_row = @{ $parser->{Cells}[$0] };
488       @header = map $_->{Val}, @header_row;
489     }
490
491   } else {
492     die "Unknown file type $type\n";
493   }
494
495   #my $columns;
496
497   local $SIG{HUP} = 'IGNORE';
498   local $SIG{INT} = 'IGNORE';
499   local $SIG{QUIT} = 'IGNORE';
500   local $SIG{TERM} = 'IGNORE';
501   local $SIG{TSTP} = 'IGNORE';
502   local $SIG{PIPE} = 'IGNORE';
503
504   my $oldAutoCommit = $FS::UID::AutoCommit;
505   local $FS::UID::AutoCommit = 0;
506   my $dbh = dbh;
507
508   #edit_import - use the header to setup looping over different rates
509   my @rate = ();
510   if ( @header ) {
511     splice(@header,0,4); # # Region Country Prefixes
512     while ( my @next = splice(@header,0,4) ) {
513       my $rate;
514       if ( $next[0] =~ /^(\d+):\s*([^:]+):/ ) {
515         $rate = qsearchs('rate', { 'ratenum' => $1 } )
516           or die "unknown ratenum $1";
517       } elsif ( $next[0] =~ /^(NEW:)?\s*([^:]+)/i ) {
518         $rate = new FS::rate { 'ratename' => $2 };
519         my $error = $rate->insert;
520         if ( $error ) {
521           $dbh->rollback if $oldAutoCommit;
522           return "error inserting new rate: $error\n";
523         }
524       }
525       push @rate, $rate;
526     }
527   }
528   die unless @rate;
529   
530   my $line;
531   my $imported = 0;
532   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
533   while (1) {
534
535     my @columns = ();
536     if ( $type eq 'csv' ) {
537
538       last unless scalar(@buffer);
539       $line = shift(@buffer);
540
541       $parser->parse($line) or do {
542         $dbh->rollback if $oldAutoCommit;
543         return "can't parse: ". $parser->error_input();
544       };
545       @columns = $parser->fields();
546
547     } elsif ( $type eq 'fixedlength' ) {
548
549       @columns = $parser->parse($line);
550
551     } elsif ( $type eq 'xls' ) {
552
553       last if $row > ($parser->{MaxRow} || $parser->{MinRow})
554            || ! $parser->{Cells}[$row];
555
556       my @row = @{ $parser->{Cells}[$row] };
557       @columns = map $_->{Val}, @row;
558
559       #my $z = 'A';
560       #warn $z++. ": $_\n" for @columns;
561
562     } else {
563       die "Unknown file type $type\n";
564     }
565
566     #edit_import loop
567
568     my @repeat = @columns[0..3];
569
570     foreach my $rate ( @rate ) {
571
572       my @later = ();
573       my %hash = %$params;
574
575       foreach my $field ( @fields ) {
576
577         my $value = shift @columns;
578        
579         if ( ref($field) eq 'CODE' ) {
580           #&{$field}(\%hash, $value);
581           push @later, $field, $value;
582         #} else {
583         } elsif ($field) { #edit_import
584           #??? $hash{$field} = $value if length($value);
585           $hash{$field} = $value if defined($value) && length($value);
586         }
587
588       }
589
590       unshift @columns, @repeat; #edit_import put these back on for next time
591
592       my $class = "FS::$table";
593
594       my $record = $class->new( \%hash );
595
596       $record->ratenum($rate->ratenum); #edit_import
597
598       #edit_improt n/a my $param = {};
599       while ( scalar(@later) ) {
600         my $sub = shift @later;
601         my $data = shift @later;
602         #&{$sub}($record, $data, $conf, $param);# $record->&{$sub}($data, $conf);
603         &{$sub}($record, $data); #edit_import - don't have $conf
604         #edit_import wrong loop last if exists( $param->{skiprow} );
605       }
606       #edit_import wrong loop next if exists( $param->{skiprow} );
607
608       #edit_import update or insert, not just insert
609       my $old = qsearchs({
610         'table'   => $table,
611         'hashref' => { map { $_ => $record->$_() } qw(ratenum dest_regionnum) },
612       });
613
614       my $error;
615       if ( $old ) {
616         $record->ratedetailnum($old->ratedetailnum);
617         $error = $record->replace($old)
618       } else {
619         $record->insert;
620       }
621
622       if ( $error ) {
623         $dbh->rollback if $oldAutoCommit;
624         return "can't insert record". ( $line ? " for $line" : '' ). ": $error";
625       }
626
627     }
628
629     $row++;
630     $imported++;
631
632     if ( $job && time - $min_sec > $last ) { #progress bar
633       $job->update_statustext( int(100 * $imported / $count) );
634       $last = time;
635     }
636
637   }
638
639   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
640
641   return "Empty file!" unless $imported || $param->{empty_ok};
642
643   ''; #no error
644
645 }
646
647 =back
648
649 =head1 BUGS
650
651 =head1 SEE ALSO
652
653 L<FS::rate>, L<FS::rate_region>, L<FS::Record>,
654 schema.html from the base documentation.
655
656 =cut
657
658 1;
659