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   local($FS::cust_payby::ignore_expired_card) = 1;
 236   local($FS::cust_payby::ignore_banned_card) = 1;
 237
 238   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
 239   # kind of a weird spot for this, but it's better than duplicating
 240   # all this code in each class...
 241   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
 242   foreach my $table ( @decrypt_tables ) {
 243       my @objects = qsearch({
 244         'table'     => $table,
 245         'hashref'   => {},
 246         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
 247                        " AND LENGTH(payinfo) > 100",
 248       });
 249       foreach my $object ( @objects ) {
 250           my $payinfo = $object->decrypt($object->payinfo);
 251           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
 252           $object->payinfo($payinfo);
 253           my $error = $object->replace;
 254           die $error if $error;
 255       }
 256   }
 257
 258 }
 259
 260 =item upgrade_data
 261
 262 =cut
 263
 264 sub upgrade_data {
 265   my %opt = @_;
 266
 267   tie my %hash, 'Tie::IxHash',
 268
 269     #cust_main (remove paycvv from history)
 270     'cust_main' => [],
 271
 272     #msgcat
 273     'msgcat' => [],
 274
 275     #reason type and reasons
 276     'reason_type'     => [],
 277     'cust_pkg_reason' => [],
 278
 279     #need part_pkg before cust_credit...
 280     'part_pkg' => [],
 281
 282     #customer credits
 283     'cust_credit' => [],
 284
 285     #duplicate history records
 286     'h_cust_svc'  => [],
 287
 288     #populate cust_pay.otaker
 289     'cust_pay'    => [],
 290
 291     #populate part_pkg_taxclass for starters
 292     'part_pkg_taxclass' => [],
 293
 294     #remove bad pending records
 295     'cust_pay_pending' => [],
 296
 297     #replace invnum and pkgnum with billpkgnum
 298     'cust_bill_pkg_detail' => [],
 299
 300     #usage_classes if we have none
 301     'usage_class' => [],
 302
 303     #phone_type if we have none
 304     'phone_type' => [],
 305
 306     #fixup access rights
 307     'access_right' => [],
 308
 309     #change recur_flat and enable_prorate
 310     'part_pkg_option' => [],
 311
 312     #add weights to pkg_category
 313     'pkg_category' => [],
 314
 315     #cdrbatch fixes
 316     'cdr' => [],
 317
 318     #otaker->usernum
 319     'cust_attachment' => [],
 320     #'cust_credit' => [],
 321     #'cust_main' => [],
 322     'cust_main_note' => [],
 323     #'cust_pay' => [],
 324     'cust_pay_void' => [],
 325     'cust_pkg' => [],
 326     #'cust_pkg_reason' => [],
 327     'cust_pkg_discount' => [],
 328     'cust_refund' => [],
 329     'banned_pay' => [],
 330
 331     #default namespace
 332     'payment_gateway' => [],
 333
 334     #migrate to templates
 335     'msg_template' => [],
 336
 337     #return unprovisioned numbers to availability
 338     'phone_avail' => [],
 339
 340     #insert scripcondition
 341     'TicketSystem' => [],
 342
 343     #insert LATA data if not already present
 344     'lata' => [],
 345
 346     #insert MSA data if not already present
 347     'msa' => [],
 348
 349     # migrate to radius_group and groupnum instead of groupname
 350     'radius_usergroup' => [],
 351     'part_svc'         => [],
 352     'part_export'      => [],
 353
 354     #insert default tower_sector if not present
 355     'tower' => [],
 356
 357     #repair improperly deleted services
 358     'cust_svc' => [],
 359
 360     #routernum/blocknum
 361     'svc_broadband' => [],
 362
 363     #set up payment gateways if needed
 364     'pay_batch' => [],
 365
 366     #flag monthly tax exemptions
 367     'cust_tax_exempt_pkg' => [],
 368
 369     #kick off tax location history upgrade
 370     'cust_bill_pkg' => [],
 371
 372     #fix taxable line item links
 373     'cust_bill_pkg_tax_location' => [],
 374
 375     #populate state FIPS codes if not already done
 376     'state' => [],
 377   ;
 378
 379   \%hash;
 380
 381 }
 382
 383 =item upgrade_schema
 384
 385 =cut
 386
 387 sub upgrade_schema {
 388   my %opt = @_;
 389
 390   my $data = upgrade_schema_data(%opt);
 391
 392   my $oldAutoCommit = $FS::UID::AutoCommit;
 393   local $FS::UID::AutoCommit = 0;
 394   local $FS::UID::AutoCommit = 0;
 395
 396   foreach my $table ( keys %$data ) {
 397
 398     my $class = "FS::$table";
 399     eval "use $class;";
 400     die $@ if $@;
 401
 402     if ( $class->can('_upgrade_schema') ) {
 403       warn "Upgrading $table schema...\n";
 404
 405       my $start = time;
 406
 407       $class->_upgrade_schema(%opt);
 408
 409       if ( $oldAutoCommit ) {
 410         warn "  committing\n";
 411         dbh->commit or die dbh->errstr;
 412       }
 413
 414       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 415       warn "  done in ". (time-$start). " seconds\n";
 416
 417     } else {
 418       warn "WARNING: asked for schema upgrade of $table,".
 419            " but FS::$table has no _upgrade_schema method\n";
 420     }
 421
 422   }
 423
 424 }
 425
 426 =item upgrade_schema_data
 427
 428 =cut
 429
 430 sub upgrade_schema_data {
 431   my %opt = @_;
 432
 433   tie my %hash, 'Tie::IxHash',
 434
 435     #fix classnum character(1)
 436     'cust_bill_pkg_detail' => [],
 437     #add necessary columns to RT schema
 438     'TicketSystem' => [],
 439
 440   ;
 441
 442   \%hash;
 443
 444 }
 445
 446 sub upgrade_sqlradius {
 447   #my %opt = @_;
 448
 449   my $conf = new FS::Conf;
 450
 451   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
 452
 453   foreach my $part_export ( @part_export ) {
 454
 455     my $errmsg = 'Error adding FreesideStatus to '.
 456                  $part_export->option('datasrc'). ': ';
 457
 458     my $dbh = DBI->connect(
 459       ( map $part_export->option($_), qw ( datasrc username password ) ),
 460       { PrintError => 0, PrintWarn => 0 }
 461     ) or do {
 462       warn $errmsg.$DBI::errstr;
 463       next;
 464     };
 465
 466     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 467     my $group = "UserName";
 468     $group .= ",Realm"
 469       if ref($part_export) =~ /withdomain/
 470       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
 471
 472     my $sth_alter = $dbh->prepare(
 473       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
 474     );
 475     if ( $sth_alter ) {
 476       if ( $sth_alter->execute ) {
 477         my $sth_update = $dbh->prepare(
 478          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
 479         ) or die $errmsg.$dbh->errstr;
 480         $sth_update->execute or die $errmsg.$sth_update->errstr;
 481       } else {
 482         my $error = $sth_alter->errstr;
 483         warn $errmsg.$error
 484           unless $error =~ /Duplicate column name/i  #mysql
 485               || $error =~ /already exists/i;        #Pg
 486 ;
 487       }
 488     } else {
 489       my $error = $dbh->errstr;
 490       warn $errmsg.$error; #unless $error =~ /exists/i;
 491     }
 492
 493     my $sth_index = $dbh->prepare(
 494       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
 495     );
 496     if ( $sth_index ) {
 497       unless ( $sth_index->execute ) {
 498         my $error = $sth_index->errstr;
 499         warn $errmsg.$error
 500           unless $error =~ /Duplicate key name/i #mysql
 501               || $error =~ /already exists/i;    #Pg
 502       }
 503     } else {
 504       my $error = $dbh->errstr;
 505       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
 506     }
 507
 508     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
 509       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
 510       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
 511
 512     my $sth = $dbh->prepare("SELECT UserName,
 513                                     Realm,
 514                                     $str2time max(AcctStartTime)),
 515                                     $str2time max(AcctStopTime))
 516                               FROM radacct
 517                               WHERE FreesideStatus = 'done'
 518                                 AND $times
 519                               GROUP BY $group
 520                             ")
 521       or die $errmsg.$dbh->errstr;
 522     $sth->execute() or die $errmsg.$sth->errstr;
 523
 524     while (my $row = $sth->fetchrow_arrayref ) {
 525       my ($username, $realm, $start, $stop) = @$row;
 526
 527       $username = lc($username) unless $conf->exists('username-uppercase');
 528
 529       my $exportnum = $part_export->exportnum;
 530       my $extra_sql = " AND exportnum = $exportnum ".
 531                       " AND exportsvcnum IS NOT NULL ";
 532
 533       if ( ref($part_export) =~ /withdomain/ ) {
 534         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
 535                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 536       }
 537
 538       my $svc_acct = qsearchs({
 539         'select'    => 'svc_acct.*',
 540         'table'     => 'svc_acct',
 541         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
 542                        'LEFT JOIN export_svc USING ( svcpart )',
 543         'hashref'   => { 'username' => $username },
 544         'extra_sql' => $extra_sql,
 545       });
 546
 547       if ($svc_acct) {
 548         $svc_acct->last_login($start)
 549           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
 550         $svc_acct->last_logout($stop)
 551           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
 552       }
 553     }
 554   }
 555
 556 }
 557
 558 =back
 559
 560 =head1 BUGS
 561
 562 Sure.
 563
 564 =head1 SEE ALSO
 565
 566 =cut
 567
 568 1;
 569