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