track taxes created by Washington sales tax lookup so they can be updated in place...
[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     #mark certain taxes as system-maintained
426     'cust_main_county' => [],
427   ;
428
429   \%hash;
430
431 }
432
433 =item upgrade_schema
434
435 =cut
436
437 sub upgrade_schema {
438   my %opt = @_;
439
440   my $data = upgrade_schema_data(%opt);
441
442   my $oldAutoCommit = $FS::UID::AutoCommit;
443   local $FS::UID::AutoCommit = 0;
444   local $FS::UID::AutoCommit = 0;
445
446   foreach my $table ( keys %$data ) {
447
448     my $class = "FS::$table";
449     eval "use $class;";
450     die $@ if $@;
451
452     if ( $class->can('_upgrade_schema') ) {
453       warn "Upgrading $table schema...\n";
454
455       my $start = time;
456
457       $class->_upgrade_schema(%opt);
458
459       if ( $oldAutoCommit ) {
460         warn "  committing\n";
461         dbh->commit or die dbh->errstr;
462       }
463       
464       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
465       warn "  done in ". (time-$start). " seconds\n";
466
467     } else {
468       warn "WARNING: asked for schema upgrade of $table,".
469            " but FS::$table has no _upgrade_schema method\n";
470     }
471
472   }
473
474 }
475
476 =item upgrade_schema_data
477
478 =cut
479
480 sub upgrade_schema_data {
481   my %opt = @_;
482
483   tie my %hash, 'Tie::IxHash', 
484
485     #fix classnum character(1)
486     'cust_bill_pkg_detail' => [],
487     #add necessary columns to RT schema
488     'TicketSystem' => [],
489
490   ;
491
492   \%hash;
493
494 }
495
496 sub upgrade_sqlradius {
497   #my %opt = @_;
498
499   my $conf = new FS::Conf;
500
501   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
502
503   foreach my $part_export ( @part_export ) {
504
505     my $errmsg = 'Error adding FreesideStatus to '.
506                  $part_export->option('datasrc'). ': ';
507
508     my $dbh = DBI->connect(
509       ( map $part_export->option($_), qw ( datasrc username password ) ),
510       { PrintError => 0, PrintWarn => 0 }
511     ) or do {
512       warn $errmsg.$DBI::errstr;
513       next;
514     };
515
516     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
517     my $group = "UserName";
518     $group .= ",Realm"
519       if ref($part_export) =~ /withdomain/
520       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
521
522     my $sth_alter = $dbh->prepare(
523       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
524     );
525     if ( $sth_alter ) {
526       if ( $sth_alter->execute ) {
527         my $sth_update = $dbh->prepare(
528          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
529         ) or die $errmsg.$dbh->errstr;
530         $sth_update->execute or die $errmsg.$sth_update->errstr;
531       } else {
532         my $error = $sth_alter->errstr;
533         warn $errmsg.$error
534           unless $error =~ /Duplicate column name/i  #mysql
535               || $error =~ /already exists/i;        #Pg
536 ;
537       }
538     } else {
539       my $error = $dbh->errstr;
540       warn $errmsg.$error; #unless $error =~ /exists/i;
541     }
542
543     my $sth_index = $dbh->prepare(
544       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
545     );
546     if ( $sth_index ) {
547       unless ( $sth_index->execute ) {
548         my $error = $sth_index->errstr;
549         warn $errmsg.$error
550           unless $error =~ /Duplicate key name/i #mysql
551               || $error =~ /already exists/i;    #Pg
552       }
553     } else {
554       my $error = $dbh->errstr;
555       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
556     }
557
558     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
559       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
560       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
561
562     my $sth = $dbh->prepare("SELECT UserName,
563                                     Realm,
564                                     $str2time max(AcctStartTime)),
565                                     $str2time max(AcctStopTime))
566                               FROM radacct
567                               WHERE FreesideStatus = 'done'
568                                 AND $times
569                               GROUP BY $group
570                             ")
571       or die $errmsg.$dbh->errstr;
572     $sth->execute() or die $errmsg.$sth->errstr;
573   
574     while (my $row = $sth->fetchrow_arrayref ) {
575       my ($username, $realm, $start, $stop) = @$row;
576   
577       $username = lc($username) unless $conf->exists('username-uppercase');
578
579       my $exportnum = $part_export->exportnum;
580       my $extra_sql = " AND exportnum = $exportnum ".
581                       " AND exportsvcnum IS NOT NULL ";
582
583       if ( ref($part_export) =~ /withdomain/ ) {
584         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
585                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
586       }
587   
588       my $svc_acct = qsearchs({
589         'select'    => 'svc_acct.*',
590         'table'     => 'svc_acct',
591         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
592                        'LEFT JOIN export_svc USING ( svcpart )',
593         'hashref'   => { 'username' => $username },
594         'extra_sql' => $extra_sql,
595       });
596
597       if ($svc_acct) {
598         $svc_acct->last_login($start)
599           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
600         $svc_acct->last_logout($stop)
601           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
602       }
603     }
604   }
605
606 }
607
608 =back
609
610 =head1 BUGS
611
612 Sure.
613
614 =head1 SEE ALSO
615
616 =cut
617
618 1;
619