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 FS::UID qw( dbh driver_name );
   8 use FS::Conf;
   9 use FS::Record qw(qsearchs qsearch str2time_sql);
  10 use FS::upgrade_journal;
  11
  12 use FS::svc_domain;
  13 $FS::svc_domain::whois_hack = 1;
  14
  15 @ISA = qw( Exporter );
  16 @EXPORT_OK = qw( upgrade_schema upgrade_config upgrade upgrade_sqlradius );
  17
  18 $DEBUG = 1;
  19
  20 =head1 NAME
  21
  22 FS::Upgrade - Database upgrade routines
  23
  24 =head1 SYNOPSIS
  25
  26   use FS::Upgrade;
  27
  28 =head1 DESCRIPTION
  29
  30 Currently this module simply provides a place to store common subroutines for
  31 database upgrades.
  32
  33 =head1 SUBROUTINES
  34
  35 =over 4
  36
  37 =item upgrade_config
  38
  39 =cut
  40
  41 #config upgrades
  42 sub upgrade_config {
  43   my %opt = @_;
  44
  45   my $conf = new FS::Conf;
  46
  47   $conf->touch('payment_receipt')
  48     if $conf->exists('payment_receipt_email')
  49     || $conf->config('payment_receipt_msgnum');
  50
  51   $conf->touch('geocode-require_nw_coordinates')
  52     if $conf->exists('svc_broadband-require-nw-coordinates');
  53
  54   unless ( $conf->config('echeck-country') ) {
  55     if ( $conf->exists('cust_main-require-bank-branch') ) {
  56       $conf->set('echeck-country', 'CA');
  57     } elsif ( $conf->exists('echeck-nonus') ) {
  58       $conf->set('echeck-country', 'XX');
  59     } else {
  60       $conf->set('echeck-country', 'US');
  61     }
  62   }
  63
  64   upgrade_overlimit_groups($conf);
  65   map { upgrade_overlimit_groups($conf,$_->agentnum) } qsearch('agent', {});
  66
  67 }
  68
  69 sub upgrade_overlimit_groups {
  70     my $conf = shift;
  71     my $agentnum = shift;
  72     my @groups = $conf->config('overlimit_groups',$agentnum);
  73     if(scalar(@groups)) {
  74         my $groups = join(',',@groups);
  75         my @groupnums;
  76         my $error = '';
  77         if ( $groups !~ /^[\d,]+$/ ) {
  78             foreach my $groupname ( @groups ) {
  79                 my $g = qsearchs('radius_group', { 'groupname' => $groupname } );
  80                 unless ( $g ) {
  81                     $g = new FS::radius_group {
  82                                     'groupname' => $groupname,
  83                                     'description' => $groupname,
  84                                     };
  85                     $error = $g->insert;
  86                     die $error if $error;
  87                 }
  88                 push @groupnums, $g->groupnum;
  89             }
  90             $conf->set('overlimit_groups',join("\n",@groupnums),$agentnum);
  91         }
  92     }
  93 }
  94
  95 =item upgrade
  96
  97 =cut
  98
  99 sub upgrade {
 100   my %opt = @_;
 101
 102   my $data = upgrade_data(%opt);
 103
 104   my $oldAutoCommit = $FS::UID::AutoCommit;
 105   local $FS::UID::AutoCommit = 0;
 106   local $FS::UID::AutoCommit = 0;
 107
 108   foreach my $table ( keys %$data ) {
 109
 110     my $class = "FS::$table";
 111     eval "use $class;";
 112     die $@ if $@;
 113
 114     if ( $class->can('_upgrade_data') ) {
 115       warn "Upgrading $table...\n";
 116
 117       my $start = time;
 118
 119       $class->_upgrade_data(%opt);
 120
 121       if ( $oldAutoCommit ) {
 122         warn "  committing\n";
 123         dbh->commit or die dbh->errstr;
 124       }
 125
 126       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 127       warn "  done in ". (time-$start). " seconds\n";
 128
 129     } else {
 130       warn "WARNING: asked for upgrade of $table,".
 131            " but FS::$table has no _upgrade_data method\n";
 132     }
 133
 134 #    my @records = @{ $data->{$table} };
 135 #
 136 #    foreach my $record ( @records ) {
 137 #      my $args = delete($record->{'_upgrade_args'}) || [];
 138 #      my $object = $class->new( $record );
 139 #      my $error = $object->insert( @$args );
 140 #      die "error inserting record into $table: $error\n"
 141 #        if $error;
 142 #    }
 143
 144   }
 145
 146   local($FS::cust_main::ignore_expired_card) = 1;
 147   local($FS::cust_main::ignore_illegal_zip) = 1;
 148   local($FS::cust_main::ignore_banned_card) = 1;
 149   local($FS::cust_main::skip_fuzzyfiles) = 1;
 150
 151   # decrypt inadvertantly-encrypted payinfo where payby != CARD,DCRD,CHEK,DCHK
 152   # kind of a weird spot for this, but it's better than duplicating
 153   # all this code in each class...
 154   my @decrypt_tables = qw( cust_main cust_pay_void cust_pay cust_refund cust_pay_pending );
 155   foreach my $table ( @decrypt_tables ) {
 156       my @objects = qsearch({
 157         'table'     => $table,
 158         'hashref'   => {},
 159         'extra_sql' => "WHERE payby NOT IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
 160                        " AND LENGTH(payinfo) > 100",
 161       });
 162       foreach my $object ( @objects ) {
 163           my $payinfo = $object->decrypt($object->payinfo);
 164           die "error decrypting payinfo" if $payinfo eq $object->payinfo;
 165           $object->payinfo($payinfo);
 166           my $error = $object->replace;
 167           die $error if $error;
 168       }
 169   }
 170
 171 }
 172
 173 =item upgrade_data
 174
 175 =cut
 176
 177 sub upgrade_data {
 178   my %opt = @_;
 179
 180   tie my %hash, 'Tie::IxHash',
 181
 182     #cust_main (remove paycvv from history)
 183     'cust_main' => [],
 184
 185     #msgcat
 186     'msgcat' => [],
 187
 188     #reason type and reasons
 189     'reason_type'     => [],
 190     'cust_pkg_reason' => [],
 191
 192     #need part_pkg before cust_credit...
 193     'part_pkg' => [],
 194
 195     #customer credits
 196     'cust_credit' => [],
 197
 198     #duplicate history records
 199     'h_cust_svc'  => [],
 200
 201     #populate cust_pay.otaker
 202     'cust_pay'    => [],
 203
 204     #populate part_pkg_taxclass for starters
 205     'part_pkg_taxclass' => [],
 206
 207     #remove bad pending records
 208     'cust_pay_pending' => [],
 209
 210     #replace invnum and pkgnum with billpkgnum
 211     'cust_bill_pkg_detail' => [],
 212
 213     #usage_classes if we have none
 214     'usage_class' => [],
 215
 216     #phone_type if we have none
 217     'phone_type' => [],
 218
 219     #fixup access rights
 220     'access_right' => [],
 221
 222     #change recur_flat and enable_prorate
 223     'part_pkg_option' => [],
 224
 225     #add weights to pkg_category
 226     'pkg_category' => [],
 227
 228     #cdrbatch fixes
 229     'cdr' => [],
 230
 231     #otaker->usernum
 232     'cust_attachment' => [],
 233     #'cust_credit' => [],
 234     #'cust_main' => [],
 235     'cust_main_note' => [],
 236     #'cust_pay' => [],
 237     'cust_pay_void' => [],
 238     'cust_pkg' => [],
 239     #'cust_pkg_reason' => [],
 240     'cust_pkg_discount' => [],
 241     'cust_refund' => [],
 242     'banned_pay' => [],
 243
 244     #default namespace
 245     'payment_gateway' => [],
 246
 247     #migrate to templates
 248     'msg_template' => [],
 249
 250     #return unprovisioned numbers to availability
 251     'phone_avail' => [],
 252
 253     #insert scripcondition
 254     'TicketSystem' => [],
 255
 256     #insert LATA data if not already present
 257     'lata' => [],
 258
 259     #insert MSA data if not already present
 260     'msa' => [],
 261
 262     # migrate to radius_group and groupnum instead of groupname
 263     'radius_usergroup' => [],
 264     'part_svc'         => [],
 265     'part_export'      => [],
 266
 267     #insert default tower_sector if not present
 268     'tower' => [],
 269
 270     #routernum/blocknum
 271     'svc_broadband' => [],
 272   ;
 273
 274   \%hash;
 275
 276 }
 277
 278 =item upgrade_schema
 279
 280 =cut
 281
 282 sub upgrade_schema {
 283   my %opt = @_;
 284
 285   my $data = upgrade_schema_data(%opt);
 286
 287   my $oldAutoCommit = $FS::UID::AutoCommit;
 288   local $FS::UID::AutoCommit = 0;
 289   local $FS::UID::AutoCommit = 0;
 290
 291   foreach my $table ( keys %$data ) {
 292
 293     my $class = "FS::$table";
 294     eval "use $class;";
 295     die $@ if $@;
 296
 297     if ( $class->can('_upgrade_schema') ) {
 298       warn "Upgrading $table schema...\n";
 299
 300       my $start = time;
 301
 302       $class->_upgrade_schema(%opt);
 303
 304       if ( $oldAutoCommit ) {
 305         warn "  committing\n";
 306         dbh->commit or die dbh->errstr;
 307       }
 308
 309       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 310       warn "  done in ". (time-$start). " seconds\n";
 311
 312     } else {
 313       warn "WARNING: asked for schema upgrade of $table,".
 314            " but FS::$table has no _upgrade_schema method\n";
 315     }
 316
 317   }
 318
 319 }
 320
 321 =item upgrade_schema_data
 322
 323 =cut
 324
 325 sub upgrade_schema_data {
 326   my %opt = @_;
 327
 328   tie my %hash, 'Tie::IxHash',
 329
 330     #fix classnum character(1)
 331     'cust_bill_pkg_detail' => [],
 332     #add necessary columns to RT schema
 333     'TicketSystem' => [],
 334
 335   ;
 336
 337   \%hash;
 338
 339 }
 340
 341 sub upgrade_sqlradius {
 342   #my %opt = @_;
 343
 344   my $conf = new FS::Conf;
 345
 346   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
 347
 348   foreach my $part_export ( @part_export ) {
 349
 350     my $errmsg = 'Error adding FreesideStatus to '.
 351                  $part_export->option('datasrc'). ': ';
 352
 353     my $dbh = DBI->connect(
 354       ( map $part_export->option($_), qw ( datasrc username password ) ),
 355       { PrintError => 0, PrintWarn => 0 }
 356     ) or do {
 357       warn $errmsg.$DBI::errstr;
 358       next;
 359     };
 360
 361     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 362     my $group = "UserName";
 363     $group .= ",Realm"
 364       if ref($part_export) =~ /withdomain/
 365       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
 366
 367     my $sth_alter = $dbh->prepare(
 368       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
 369     );
 370     if ( $sth_alter ) {
 371       if ( $sth_alter->execute ) {
 372         my $sth_update = $dbh->prepare(
 373          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
 374         ) or die $errmsg.$dbh->errstr;
 375         $sth_update->execute or die $errmsg.$sth_update->errstr;
 376       } else {
 377         my $error = $sth_alter->errstr;
 378         warn $errmsg.$error
 379           unless $error =~ /Duplicate column name/i  #mysql
 380               || $error =~ /already exists/i;        #Pg
 381 ;
 382       }
 383     } else {
 384       my $error = $dbh->errstr;
 385       warn $errmsg.$error; #unless $error =~ /exists/i;
 386     }
 387
 388     my $sth_index = $dbh->prepare(
 389       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
 390     );
 391     if ( $sth_index ) {
 392       unless ( $sth_index->execute ) {
 393         my $error = $sth_index->errstr;
 394         warn $errmsg.$error
 395           unless $error =~ /Duplicate key name/i #mysql
 396               || $error =~ /already exists/i;    #Pg
 397       }
 398     } else {
 399       my $error = $dbh->errstr;
 400       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
 401     }
 402
 403     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
 404       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
 405       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
 406
 407     my $sth = $dbh->prepare("SELECT UserName,
 408                                     Realm,
 409                                     $str2time max(AcctStartTime)),
 410                                     $str2time max(AcctStopTime))
 411                               FROM radacct
 412                               WHERE FreesideStatus = 'done'
 413                                 AND $times
 414                               GROUP BY $group
 415                             ")
 416       or die $errmsg.$dbh->errstr;
 417     $sth->execute() or die $errmsg.$sth->errstr;
 418
 419     while (my $row = $sth->fetchrow_arrayref ) {
 420       my ($username, $realm, $start, $stop) = @$row;
 421
 422       $username = lc($username) unless $conf->exists('username-uppercase');
 423
 424       my $exportnum = $part_export->exportnum;
 425       my $extra_sql = " AND exportnum = $exportnum ".
 426                       " AND exportsvcnum IS NOT NULL ";
 427
 428       if ( ref($part_export) =~ /withdomain/ ) {
 429         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
 430                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 431       }
 432
 433       my $svc_acct = qsearchs({
 434         'select'    => 'svc_acct.*',
 435         'table'     => 'svc_acct',
 436         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
 437                        'LEFT JOIN export_svc USING ( svcpart )',
 438         'hashref'   => { 'username' => $username },
 439         'extra_sql' => $extra_sql,
 440       });
 441
 442       if ($svc_acct) {
 443         $svc_acct->last_login($start)
 444           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
 445         $svc_acct->last_logout($stop)
 446           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
 447       }
 448     }
 449   }
 450
 451 }
 452
 453 =back
 454
 455 =head1 BUGS
 456
 457 Sure.
 458
 459 =head1 SEE ALSO
 460
 461 =cut
 462
 463 1;
 464