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