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 }
 149
 150 sub upgrade_overlimit_groups {
 151     my $conf = shift;
 152     my $agentnum = shift;
 153     my @groups = $conf->config('overlimit_groups',$agentnum);
 154     if(scalar(@groups)) {
 155         my $groups = join(',',@groups);
 156         my @groupnums;
 157         my $error = '';
 158         if ( $groups !~ /^[\d,]+$/ ) {
 159             foreach my $groupname ( @groups ) {
 160                 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
 161                 unless ( $g ) {
 162                     $g = new FS::radius_group {
 163                                     'groupname' => $groupname,
 164                                     'description' => $groupname,
 165                                     };
 166                     $error = $g->insert;
 167                     die $error if $error;
 168                 }
 169                 push @groupnums, $g->groupnum;
 170             }
 171             $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
 172         }
 173     }
 174 }
 175
 176 sub upgrade_invoice_from {
 177   my ($conf, $agentnum, $agentonly) = @_;
 178   if (
 179       (!$conf->exists('invoice_from_name',$agentnum,$agentonly)) &&
 180       ($conf->config('invoice_from',$agentnum,$agentonly) =~ /\<(.*)\>/)
 181   ) {
 182     my $realemail = $1;
 183     $realemail =~ s/^\s*//; # remove leading spaces
 184     $realemail =~ s/\s*$//; # remove trailing spaces
 185     my $realname = $conf->config('invoice_from',$agentnum);
 186     $realname =~ s/\<.*\>//; # remove email address
 187     $realname =~ s/^\s*//; # remove leading spaces
 188     $realname =~ s/\s*$//; # remove trailing spaces
 189     # properly quote names that contain punctuation
 190     if (($realname =~ /[^[:alnum:][:space:]]/) && ($realname !~ /^\".*\"$/)) {
 191       $realname = '"' . $realname . '"';
 192     }
 193     $conf->set('invoice_from_name', $realname, $agentnum);
 194     $conf->set('invoice_from', $realemail, $agentnum);
 195   }
 196 }
 197
 198 =item upgrade
 199
 200 =cut
 201
 202 sub upgrade {
 203   my %opt = @_;
 204
 205   my $data = upgrade_data(%opt);
 206
 207   my $oldAutoCommit = $FS::UID::AutoCommit;
 208   local $FS::UID::AutoCommit = 0;
 209   local $FS::UID::AutoCommit = 0;
 210
 211   local $FS::cust_pkg::upgrade = 1; #go away after setup+start dates cleaned up for old customers
 212
 213
 214   foreach my $table ( keys %$data ) {
 215
 216     my $class = "FS::$table";
 217     eval "use $class;";
 218     die $@ if $@;
 219
 220     if ( $class->can('_upgrade_data') ) {
 221       warn "Upgrading $table...\n";
 222
 223       my $start = time;
 224
 225       $class->_upgrade_data(%opt);
 226
 227       # New interface for async upgrades: a class can declare a
 228       # "queueable_upgrade" method, which will run as part of the normal
 229       # upgrade, but if the -j option is passed, will instead be run from
 230       # the job queue.
 231       if ( $class->can('queueable_upgrade') ) {
 232         my $jobname = $class . '::queueable_upgrade';
 233         my $num_jobs = FS::queue->count("job = '$jobname' and status != 'failed'");
 234         if ($num_jobs > 0) {
 235           warn "$class upgrade already scheduled.\n";
 236         } else {
 237           if ( $opt{'queue'} ) {
 238             warn "Scheduling $class upgrade.\n";
 239             my $job = FS::queue->new({ job => $jobname });
 240             $job->insert($class, %opt);
 241           } else {
 242             $class->queueable_upgrade(%opt);
 243           }
 244         } #$num_jobs == 0
 245       }
 246
 247       if ( $oldAutoCommit ) {
 248         warn "  committing\n";
 249         dbh->commit or die dbh->errstr;
 250       }
 251
 252       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 253       warn "  done in ". (time-$start). " seconds\n";
 254
 255     } else {
 256       warn "WARNING: asked for upgrade of $table,".
 257            " but FS::$table has no _upgrade_data method\n";
 258     }
 259
 260 #    my @records = @{ $data->{$table} };
 261 #
 262 #    foreach my $record ( @records ) {
 263 #      my $args = delete($record->{'_upgrade_args'}) || [];
 264 #      my $object = $class->new( $record );
 265 #      my $error = $object->insert( @$args );
 266 #      die "error inserting record into $table: $error\n"
 267 #        if $error;
 268 #    }
 269
 270   }
 271
 272   local($FS::cust_main::ignore_expired_card) = 1;
 273   local($FS::cust_main::ignore_illegal_zip) = 1;
 274   local($FS::cust_main::ignore_banned_card) = 1;
 275   local($FS::cust_main::skip_fuzzyfiles) = 1;
 276
 277   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
 278   # kind of a weird spot for this, but it's better than duplicating
 279   # all this code in each class...
 280   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
 281   foreach my $table ( @decrypt_tables ) {
 282       my @objects = qsearch({
 283         'table'     => $table,
 284         'hashref'   => {},
 285         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
 286                        " AND LENGTH(payinfo) > 100",
 287       });
 288       foreach my $object ( @objects ) {
 289           my $payinfo = $object->decrypt($object->payinfo);
 290           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
 291           $object->payinfo($payinfo);
 292           my $error = $object->replace;
 293           die $error if $error;
 294       }
 295   }
 296
 297 }
 298
 299 =item upgrade_data
 300
 301 =cut
 302
 303 sub upgrade_data {
 304   my %opt = @_;
 305
 306   tie my %hash, 'Tie::IxHash',
 307
 308     #cust_main (remove paycvv from history)
 309     'cust_main' => [],
 310
 311     #msgcat
 312     'msgcat' => [],
 313
 314     #reason type and reasons
 315     'reason_type'     => [],
 316     'cust_pkg_reason' => [],
 317
 318     #need part_pkg before cust_credit...
 319     'part_pkg' => [],
 320
 321     #customer credits
 322     'cust_credit' => [],
 323
 324     #duplicate history records
 325     'h_cust_svc'  => [],
 326
 327     #populate cust_pay.otaker
 328     'cust_pay'    => [],
 329
 330     #populate part_pkg_taxclass for starters
 331     'part_pkg_taxclass' => [],
 332
 333     #remove bad pending records
 334     'cust_pay_pending' => [],
 335
 336     #replace invnum and pkgnum with billpkgnum
 337     'cust_bill_pkg_detail' => [],
 338
 339     #usage_classes if we have none
 340     'usage_class' => [],
 341
 342     #phone_type if we have none
 343     'phone_type' => [],
 344
 345     #fixup access rights
 346     'access_right' => [],
 347
 348     #change recur_flat and enable_prorate
 349     'part_pkg_option' => [],
 350
 351     #add weights to pkg_category
 352     'pkg_category' => [],
 353
 354     #cdrbatch fixes
 355     'cdr' => [],
 356
 357     #otaker->usernum
 358     'cust_attachment' => [],
 359     #'cust_credit' => [],
 360     #'cust_main' => [],
 361     'cust_main_note' => [],
 362     #'cust_pay' => [],
 363     'cust_pay_void' => [],
 364     'cust_pkg' => [],
 365     #'cust_pkg_reason' => [],
 366     'cust_pkg_discount' => [],
 367     'cust_refund' => [],
 368     'banned_pay' => [],
 369
 370     #default namespace
 371     'payment_gateway' => [],
 372
 373     #migrate to templates
 374     'msg_template' => [],
 375
 376     #return unprovisioned numbers to availability
 377     'phone_avail' => [],
 378
 379     #insert scripcondition
 380     'TicketSystem' => [],
 381
 382     #insert LATA data if not already present
 383     'lata' => [],
 384
 385     #insert MSA data if not already present
 386     'msa' => [],
 387
 388     # migrate to radius_group and groupnum instead of groupname
 389     'radius_usergroup' => [],
 390     'part_svc'         => [],
 391     'part_export'      => [],
 392
 393     #insert default tower_sector if not present
 394     'tower' => [],
 395
 396     #repair improperly deleted services
 397     'cust_svc' => [],
 398
 399     #routernum/blocknum
 400     'svc_broadband' => [],
 401
 402     #set up payment gateways if needed
 403     'pay_batch' => [],
 404
 405     #flag monthly tax exemptions
 406     'cust_tax_exempt_pkg' => [],
 407
 408     #kick off tax location history upgrade
 409     'cust_bill_pkg' => [],
 410
 411     #fix taxable line item links
 412     'cust_bill_pkg_tax_location' => [],
 413
 414     #populate state FIPS codes if not already done
 415     'state' => [],
 416
 417     #set default locations on quoted packages
 418     'quotation_pkg' => [],
 419   ;
 420
 421   \%hash;
 422
 423 }
 424
 425 =item upgrade_schema
 426
 427 =cut
 428
 429 sub upgrade_schema {
 430   my %opt = @_;
 431
 432   my $data = upgrade_schema_data(%opt);
 433
 434   my $oldAutoCommit = $FS::UID::AutoCommit;
 435   local $FS::UID::AutoCommit = 0;
 436   local $FS::UID::AutoCommit = 0;
 437
 438   foreach my $table ( keys %$data ) {
 439
 440     my $class = "FS::$table";
 441     eval "use $class;";
 442     die $@ if $@;
 443
 444     if ( $class->can('_upgrade_schema') ) {
 445       warn "Upgrading $table schema...\n";
 446
 447       my $start = time;
 448
 449       $class->_upgrade_schema(%opt);
 450
 451       if ( $oldAutoCommit ) {
 452         warn "  committing\n";
 453         dbh->commit or die dbh->errstr;
 454       }
 455
 456       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 457       warn "  done in ". (time-$start). " seconds\n";
 458
 459     } else {
 460       warn "WARNING: asked for schema upgrade of $table,".
 461            " but FS::$table has no _upgrade_schema method\n";
 462     }
 463
 464   }
 465
 466 }
 467
 468 =item upgrade_schema_data
 469
 470 =cut
 471
 472 sub upgrade_schema_data {
 473   my %opt = @_;
 474
 475   tie my %hash, 'Tie::IxHash',
 476
 477     #fix classnum character(1)
 478     'cust_bill_pkg_detail' => [],
 479     #add necessary columns to RT schema
 480     'TicketSystem' => [],
 481
 482   ;
 483
 484   \%hash;
 485
 486 }
 487
 488 sub upgrade_sqlradius {
 489   #my %opt = @_;
 490
 491   my $conf = new FS::Conf;
 492
 493   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
 494
 495   foreach my $part_export ( @part_export ) {
 496
 497     my $errmsg = 'Error adding FreesideStatus to '.
 498                  $part_export->option('datasrc'). ': ';
 499
 500     my $dbh = DBI->connect(
 501       ( map $part_export->option($_), qw ( datasrc username password ) ),
 502       { PrintError => 0, PrintWarn => 0 }
 503     ) or do {
 504       warn $errmsg.$DBI::errstr;
 505       next;
 506     };
 507
 508     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 509     my $group = "UserName";
 510     $group .= ",Realm"
 511       if ref($part_export) =~ /withdomain/
 512       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
 513
 514     my $sth_alter = $dbh->prepare(
 515       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
 516     );
 517     if ( $sth_alter ) {
 518       if ( $sth_alter->execute ) {
 519         my $sth_update = $dbh->prepare(
 520          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
 521         ) or die $errmsg.$dbh->errstr;
 522         $sth_update->execute or die $errmsg.$sth_update->errstr;
 523       } else {
 524         my $error = $sth_alter->errstr;
 525         warn $errmsg.$error
 526           unless $error =~ /Duplicate column name/i  #mysql
 527               || $error =~ /already exists/i;        #Pg
 528 ;
 529       }
 530     } else {
 531       my $error = $dbh->errstr;
 532       warn $errmsg.$error; #unless $error =~ /exists/i;
 533     }
 534
 535     my $sth_index = $dbh->prepare(
 536       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
 537     );
 538     if ( $sth_index ) {
 539       unless ( $sth_index->execute ) {
 540         my $error = $sth_index->errstr;
 541         warn $errmsg.$error
 542           unless $error =~ /Duplicate key name/i #mysql
 543               || $error =~ /already exists/i;    #Pg
 544       }
 545     } else {
 546       my $error = $dbh->errstr;
 547       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
 548     }
 549
 550     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
 551       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
 552       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
 553
 554     my $sth = $dbh->prepare("SELECT UserName,
 555                                     Realm,
 556                                     $str2time max(AcctStartTime)),
 557                                     $str2time max(AcctStopTime))
 558                               FROM radacct
 559                               WHERE FreesideStatus = 'done'
 560                                 AND $times
 561                               GROUP BY $group
 562                             ")
 563       or die $errmsg.$dbh->errstr;
 564     $sth->execute() or die $errmsg.$sth->errstr;
 565
 566     while (my $row = $sth->fetchrow_arrayref ) {
 567       my ($username, $realm, $start, $stop) = @$row;
 568
 569       $username = lc($username) unless $conf->exists('username-uppercase');
 570
 571       my $exportnum = $part_export->exportnum;
 572       my $extra_sql = " AND exportnum = $exportnum ".
 573                       " AND exportsvcnum IS NOT NULL ";
 574
 575       if ( ref($part_export) =~ /withdomain/ ) {
 576         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
 577                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 578       }
 579
 580       my $svc_acct = qsearchs({
 581         'select'    => 'svc_acct.*',
 582         'table'     => 'svc_acct',
 583         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
 584                        'LEFT JOIN export_svc USING ( svcpart )',
 585         'hashref'   => { 'username' => $username },
 586         'extra_sql' => $extra_sql,
 587       });
 588
 589       if ($svc_acct) {
 590         $svc_acct->last_login($start)
 591           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
 592         $svc_acct->last_logout($stop)
 593           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
 594       }
 595     }
 596   }
 597
 598 }
 599
 600 =back
 601
 602 =head1 BUGS
 603
 604 Sure.
 605
 606 =head1 SEE ALSO
 607
 608 =cut
 609
 610 1;
 611