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