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