zip email CDRs, RT#40112
[freeside.git] / FS / FS / Upgrade.pm
1 package FS::Upgrade;
2
3 use strict;
4 use vars qw( @ISA @EXPORT_OK $DEBUG );
5 use Exporter;
6 use Tie::IxHash;
7 use File::Slurp;
8 use FS::UID qw( dbh driver_name );
9 use FS::Conf;
10 use FS::Record qw(qsearchs qsearch str2time_sql);
11 use FS::queue;
12 use FS::upgrade_journal;
13
14 use FS::svc_domain;
15 $FS::svc_domain::whois_hack = 1;
16
17 @ISA = qw( Exporter );
18 @EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
19
20 $DEBUG = 1;
21
22 =head1 NAME
23
24 FS::Upgrade - Database upgrade routines
25
26 =head1 SYNOPSIS
27
28   use FS::Upgrade;
29
30 =head1 DESCRIPTION
31
32 Currently this module simply provides a place to store common subroutines for
33 database upgrades.
34
35 =head1 SUBROUTINES
36
37 =over 4
38
39 =item upgrade_config
40
41 =cut
42
43 #config upgrades
44 sub upgrade_config {
45   my %opt = @_;
46
47   my $conf = new FS::Conf;
48
49   $conf->touch('payment_receipt')
50     if $conf->exists('payment_receipt_email')
51     || $conf->config('payment_receipt_msgnum');
52
53   $conf->touch('geocode-require_nw_coordinates')
54     if $conf->exists('svc_broadband-require-nw-coordinates');
55
56   unless ( $conf->config('echeck-country') ) {
57     if ( $conf->exists('cust_main-require-bank-branch') ) {
58       $conf->set('echeck-country', 'CA');
59     } elsif ( $conf->exists('echeck-nonus') ) {
60       $conf->set('echeck-country', 'XX');
61     } else {
62       $conf->set('echeck-country', 'US');
63     }
64   }
65
66   my @agents = qsearch('agent', {});
67
68   upgrade_overlimit_groups($conf);
69   map { upgrade_overlimit_groups($conf,$_->agentnum) } @agents;
70
71   upgrade_invoice_from($conf);
72   foreach my $agent (@agents) {
73     upgrade_invoice_from($conf,$agent->agentnum,1);
74   }
75
76   my $DIST_CONF = '/usr/local/etc/freeside/default_conf/';#DIST_CONF in Makefile
77   $conf->set($_, scalar(read_file( "$DIST_CONF/$_" )) )
78     foreach grep { ! $conf->exists($_) && -s "$DIST_CONF/$_" }
79       qw( quotation_html quotation_latex quotation_latexnotes );
80
81   # change 'fslongtable' to 'longtable'
82   # in invoice and quotation main templates, and also in all secondary 
83   # invoice templates
84   my @latex_confs =
85     qsearch('conf', { 'name' => {op=>'LIKE', value=>'%latex%'} });
86
87   foreach my $c (@latex_confs) {
88     my $value = $c->value;
89     if (length($value) and $value =~ /fslongtable/) {
90       $value =~ s/fslongtable/longtable/g;
91       $conf->set($c->name, $value, $c->agentnum);
92     }
93   }
94
95   # if there's a USPS tools login, assume that's the standardization method
96   # you want to use
97   $conf->set('address_standardize_method', 'usps')
98     if $conf->exists('usps_webtools-userid')
99     && length($conf->config('usps_webtools-userid')) > 0
100     && ! $conf->exists('address_standardize_method');
101
102   # this option has been renamed/expanded
103   if ( $conf->exists('cust_main-enable_spouse_birthdate') ) {
104     $conf->touch('cust_main-enable_spouse');
105     $conf->delete('cust_main-enable_spouse_birthdate');
106   }
107
108   # renamed/repurposed
109   if ( $conf->exists('cust_pkg-show_fcc_voice_grade_equivalent') ) {
110     $conf->touch('part_pkg-show_fcc_options');
111     $conf->delete('cust_pkg-show_fcc_voice_grade_equivalent');
112     warn "
113 You have FCC Form 477 package options enabled.
114
115 Starting with the October 2014 filing date, the FCC has redesigned 
116 Form 477 and introduced new service categories.  See bin/convert-477-options
117 to update your package configuration for the new report.
118
119 If you need to continue using the old Form 477 report, turn on the
120 'old_fcc_report' configuration option.
121 ";
122   }
123
124   # boolean invoice_sections_by_location option is now
125   # invoice_sections_method = 'location'
126   my @invoice_sections_confs =
127     qsearch('conf', { 'name' => { op=>'LIKE', value=>'%sections_by_location' } });
128   foreach my $c (@invoice_sections_confs) {
129     $c->name =~ /^(\w+)sections_by_location$/;
130     $conf->delete($c->name);
131     my $newname = $1.'sections_method';
132     $conf->set($newname, 'location');
133   }
134
135   # boolean tax-cust_exempt-groups-require_individual_nums is now -num_req all
136   if ( $conf->exists('tax-cust_exempt-groups-require_individual_nums') ) {
137     $conf->set('tax-cust_exempt-groups-num_req', 'all');
138     $conf->delete('tax-cust_exempt-groups-require_individual_nums');
139   }
140
141   # boolean+text previous_balance-exclude_from_total is now two separate options
142   my $total_new_charges = $conf->config('previous_balance-exclude_from_total');
143   if (length($total_new_charges) > 0) {
144     $conf->set('previous_balance-text-total_new_charges', $total_new_charges);
145     $conf->set('previous_balance-exclude_from_total', '');
146   }
147
148   if ( $conf->exists('voip-cust_email_csv_cdr') ) {
149     $conf->set('voip_cdr_email_attach', 'csv');
150     $conf->delete('voip-cust_email_csv_cdr') ;
151   }
152
153 }
154
155 sub upgrade_overlimit_groups {
156     my $conf = shift;
157     my $agentnum = shift;
158     my @groups = $conf->config('overlimit_groups',$agentnum); 
159     if(scalar(@groups)) {
160         my $groups = join(',',@groups);
161         my @groupnums;
162         my $error = '';
163         if ( $groups !~ /^[\d,]+$/ ) {
164             foreach my $groupname ( @groups ) {
165                 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
166                 unless ( $g ) {
167                     $g = new FS::radius_group {
168                                     'groupname' => $groupname,
169                                     'description' => $groupname,
170                                     };
171                     $error = $g->insert;
172                     die $error if $error;
173                 }
174                 push @groupnums, $g->groupnum;
175             }
176             $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
177         }
178     }
179 }
180
181 sub upgrade_invoice_from {
182   my ($conf, $agentnum, $agentonly) = @_;
183   if (
184       (!$conf->exists('invoice_from_name',$agentnum,$agentonly)) && 
185       ($conf->config('invoice_from',$agentnum,$agentonly) =~ /\<(.*)\>/)
186   ) {
187     my $realemail = $1;
188     $realemail =~ s/^\s*//; # remove leading spaces
189     $realemail =~ s/\s*$//; # remove trailing spaces
190     my $realname = $conf->config('invoice_from',$agentnum);
191     $realname =~ s/\<.*\>//; # remove email address
192     $realname =~ s/^\s*//; # remove leading spaces
193     $realname =~ s/\s*$//; # remove trailing spaces
194     # properly quote names that contain punctuation
195     if (($realname =~ /[^[:alnum:][:space:]]/) && ($realname !~ /^\".*\"$/)) {
196       $realname = '"' . $realname . '"';
197     }
198     $conf->set('invoice_from_name', $realname, $agentnum);
199     $conf->set('invoice_from', $realemail, $agentnum);
200   }
201 }
202
203 =item upgrade
204
205 =cut
206
207 sub upgrade {
208   my %opt = @_;
209
210   my $data = upgrade_data(%opt);
211
212   my $oldAutoCommit = $FS::UID::AutoCommit;
213   local $FS::UID::AutoCommit = 0;
214   local $FS::UID::AutoCommit = 0;
215
216   local $FS::cust_pkg::upgrade = 1; #go away after setup+start dates cleaned up for old customers
217
218
219   foreach my $table ( keys %$data ) {
220
221     my $class = "FS::$table";
222     eval "use $class;";
223     die $@ if $@;
224
225     if ( $class->can('_upgrade_data') ) {
226       warn "Upgrading $table...\n";
227
228       my $start = time;
229
230       $class->_upgrade_data(%opt);
231
232       # New interface for async upgrades: a class can declare a 
233       # "queueable_upgrade" method, which will run as part of the normal 
234       # upgrade, but if the -j option is passed, will instead be run from 
235       # the job queue.
236       if ( $class->can('queueable_upgrade') ) {
237         my $jobname = $class . '::queueable_upgrade';
238         my $num_jobs = FS::queue->count("job = '$jobname' and status != 'failed'");
239         if ($num_jobs > 0) {
240           warn "$class upgrade already scheduled.\n";
241         } else {
242           if ( $opt{'queue'} ) {
243             warn "Scheduling $class upgrade.\n";
244             my $job = FS::queue->new({ job => $jobname });
245             $job->insert($class, %opt);
246           } else {
247             $class->queueable_upgrade(%opt);
248           }
249         } #$num_jobs == 0
250       }
251
252       if ( $oldAutoCommit ) {
253         warn "  committing\n";
254         dbh->commit or die dbh->errstr;
255       }
256       
257       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
258       warn "  done in ". (time-$start). " seconds\n";
259
260     } else {
261       warn "WARNING: asked for upgrade of $table,".
262            " but FS::$table has no _upgrade_data method\n";
263     }
264
265 #    my @records = @{ $data->{$table} };
266 #
267 #    foreach my $record ( @records ) {
268 #      my $args = delete($record->{'_upgrade_args'}) || [];
269 #      my $object = $class->new( $record );
270 #      my $error = $object->insert( @$args );
271 #      die "error inserting record into $table: $error\n"
272 #        if $error;
273 #    }
274
275   }
276
277   local($FS::cust_main::ignore_expired_card) = 1;
278   local($FS::cust_main::ignore_illegal_zip) = 1;
279   local($FS::cust_main::ignore_banned_card) = 1;
280   local($FS::cust_main::skip_fuzzyfiles) = 1;
281
282   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
283   # kind of a weird spot for this, but it's better than duplicating
284   # all this code in each class...
285   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
286   foreach my $table ( @decrypt_tables ) {
287       my @objects = qsearch({
288         'table'     => $table,
289         'hashref'   => {},
290         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
291                        " AND LENGTH(payinfo) > 100",
292       });
293       foreach my $object ( @objects ) {
294           my $payinfo = $object->decrypt($object->payinfo);
295           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
296           $object->payinfo($payinfo);
297           my $error = $object->replace;
298           die $error if $error;
299       }
300   }
301
302 }
303
304 =item upgrade_data
305
306 =cut
307
308 sub upgrade_data {
309   my %opt = @_;
310
311   tie my %hash, 'Tie::IxHash', 
312
313     #cust_main (remove paycvv from history)
314     'cust_main' => [],
315
316     #msgcat
317     'msgcat' => [],
318
319     #reason type and reasons
320     'reason_type'     => [],
321     'cust_pkg_reason' => [],
322
323     #need part_pkg before cust_credit...
324     'part_pkg' => [],
325
326     #customer credits
327     'cust_credit' => [],
328
329     #duplicate history records
330     'h_cust_svc'  => [],
331
332     #populate cust_pay.otaker
333     'cust_pay'    => [],
334
335     #populate part_pkg_taxclass for starters
336     'part_pkg_taxclass' => [],
337
338     #remove bad pending records
339     'cust_pay_pending' => [],
340
341     #replace invnum and pkgnum with billpkgnum
342     'cust_bill_pkg_detail' => [],
343
344     #usage_classes if we have none
345     'usage_class' => [],
346
347     #phone_type if we have none
348     'phone_type' => [],
349
350     #fixup access rights
351     'access_right' => [],
352
353     #change recur_flat and enable_prorate
354     'part_pkg_option' => [],
355
356     #add weights to pkg_category
357     'pkg_category' => [],
358
359     #cdrbatch fixes
360     'cdr' => [],
361
362     #otaker->usernum
363     'cust_attachment' => [],
364     #'cust_credit' => [],
365     #'cust_main' => [],
366     'cust_main_note' => [],
367     #'cust_pay' => [],
368     'cust_pay_void' => [],
369     'cust_pkg' => [],
370     #'cust_pkg_reason' => [],
371     'cust_pkg_discount' => [],
372     'cust_refund' => [],
373     'banned_pay' => [],
374
375     #default namespace
376     'payment_gateway' => [],
377
378     #migrate to templates
379     'msg_template' => [],
380
381     #return unprovisioned numbers to availability
382     'phone_avail' => [],
383
384     #insert scripcondition
385     'TicketSystem' => [],
386     
387     #insert LATA data if not already present
388     'lata' => [],
389     
390     #insert MSA data if not already present
391     'msa' => [],
392
393     # migrate to radius_group and groupnum instead of groupname
394     'radius_usergroup' => [],
395     'part_svc'         => [],
396     'part_export'      => [],
397
398     #insert default tower_sector if not present
399     'tower' => [],
400
401     #repair improperly deleted services
402     'cust_svc' => [],
403
404     #routernum/blocknum
405     'svc_broadband' => [],
406
407     #set up payment gateways if needed
408     'pay_batch' => [],
409
410     #flag monthly tax exemptions
411     'cust_tax_exempt_pkg' => [],
412
413     #kick off tax location history upgrade
414     'cust_bill_pkg' => [],
415
416     #fix taxable line item links
417     'cust_bill_pkg_tax_location' => [],
418
419     #populate state FIPS codes if not already done
420     'state' => [],
421
422     #set default locations on quoted packages
423     'quotation_pkg' => [],
424   ;
425
426   \%hash;
427
428 }
429
430 =item upgrade_schema
431
432 =cut
433
434 sub upgrade_schema {
435   my %opt = @_;
436
437   my $data = upgrade_schema_data(%opt);
438
439   my $oldAutoCommit = $FS::UID::AutoCommit;
440   local $FS::UID::AutoCommit = 0;
441   local $FS::UID::AutoCommit = 0;
442
443   foreach my $table ( keys %$data ) {
444
445     my $class = "FS::$table";
446     eval "use $class;";
447     die $@ if $@;
448
449     if ( $class->can('_upgrade_schema') ) {
450       warn "Upgrading $table schema...\n";
451
452       my $start = time;
453
454       $class->_upgrade_schema(%opt);
455
456       if ( $oldAutoCommit ) {
457         warn "  committing\n";
458         dbh->commit or die dbh->errstr;
459       }
460       
461       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
462       warn "  done in ". (time-$start). " seconds\n";
463
464     } else {
465       warn "WARNING: asked for schema upgrade of $table,".
466            " but FS::$table has no _upgrade_schema method\n";
467     }
468
469   }
470
471 }
472
473 =item upgrade_schema_data
474
475 =cut
476
477 sub upgrade_schema_data {
478   my %opt = @_;
479
480   tie my %hash, 'Tie::IxHash', 
481
482     #fix classnum character(1)
483     'cust_bill_pkg_detail' => [],
484     #add necessary columns to RT schema
485     'TicketSystem' => [],
486
487   ;
488
489   \%hash;
490
491 }
492
493 sub upgrade_sqlradius {
494   #my %opt = @_;
495
496   my $conf = new FS::Conf;
497
498   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
499
500   foreach my $part_export ( @part_export ) {
501
502     my $errmsg = 'Error adding FreesideStatus to '.
503                  $part_export->option('datasrc'). ': ';
504
505     my $dbh = DBI->connect(
506       ( map $part_export->option($_), qw ( datasrc username password ) ),
507       { PrintError => 0, PrintWarn => 0 }
508     ) or do {
509       warn $errmsg.$DBI::errstr;
510       next;
511     };
512
513     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
514     my $group = "UserName";
515     $group .= ",Realm"
516       if ref($part_export) =~ /withdomain/
517       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
518
519     my $sth_alter = $dbh->prepare(
520       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
521     );
522     if ( $sth_alter ) {
523       if ( $sth_alter->execute ) {
524         my $sth_update = $dbh->prepare(
525          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
526         ) or die $errmsg.$dbh->errstr;
527         $sth_update->execute or die $errmsg.$sth_update->errstr;
528       } else {
529         my $error = $sth_alter->errstr;
530         warn $errmsg.$error
531           unless $error =~ /Duplicate column name/i  #mysql
532               || $error =~ /already exists/i;        #Pg
533 ;
534       }
535     } else {
536       my $error = $dbh->errstr;
537       warn $errmsg.$error; #unless $error =~ /exists/i;
538     }
539
540     my $sth_index = $dbh->prepare(
541       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
542     );
543     if ( $sth_index ) {
544       unless ( $sth_index->execute ) {
545         my $error = $sth_index->errstr;
546         warn $errmsg.$error
547           unless $error =~ /Duplicate key name/i #mysql
548               || $error =~ /already exists/i;    #Pg
549       }
550     } else {
551       my $error = $dbh->errstr;
552       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
553     }
554
555     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
556       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
557       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
558
559     my $sth = $dbh->prepare("SELECT UserName,
560                                     Realm,
561                                     $str2time max(AcctStartTime)),
562                                     $str2time max(AcctStopTime))
563                               FROM radacct
564                               WHERE FreesideStatus = 'done'
565                                 AND $times
566                               GROUP BY $group
567                             ")
568       or die $errmsg.$dbh->errstr;
569     $sth->execute() or die $errmsg.$sth->errstr;
570   
571     while (my $row = $sth->fetchrow_arrayref ) {
572       my ($username, $realm, $start, $stop) = @$row;
573   
574       $username = lc($username) unless $conf->exists('username-uppercase');
575
576       my $exportnum = $part_export->exportnum;
577       my $extra_sql = " AND exportnum = $exportnum ".
578                       " AND exportsvcnum IS NOT NULL ";
579
580       if ( ref($part_export) =~ /withdomain/ ) {
581         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
582                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
583       }
584   
585       my $svc_acct = qsearchs({
586         'select'    => 'svc_acct.*',
587         'table'     => 'svc_acct',
588         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
589                        'LEFT JOIN export_svc USING ( svcpart )',
590         'hashref'   => { 'username' => $username },
591         'extra_sql' => $extra_sql,
592       });
593
594       if ($svc_acct) {
595         $svc_acct->last_login($start)
596           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
597         $svc_acct->last_logout($stop)
598           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
599       }
600     }
601   }
602
603 }
604
605 =back
606
607 =head1 BUGS
608
609 Sure.
610
611 =head1 SEE ALSO
612
613 =cut
614
615 1;
616