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     #set up payment gateways if needed
 274     'pay_batch' => [],
 275   ;
 276
 277   \%hash;
 278
 279 }
 280
 281 =item upgrade_schema
 282
 283 =cut
 284
 285 sub upgrade_schema {
 286   my %opt = @_;
 287
 288   my $data = upgrade_schema_data(%opt);
 289
 290   my $oldAutoCommit = $FS::UID::AutoCommit;
 291   local $FS::UID::AutoCommit = 0;
 292   local $FS::UID::AutoCommit = 0;
 293
 294   foreach my $table ( keys %$data ) {
 295
 296     my $class = "FS::$table";
 297     eval "use $class;";
 298     die $@ if $@;
 299
 300     if ( $class->can('_upgrade_schema') ) {
 301       warn "Upgrading $table schema...\n";
 302
 303       my $start = time;
 304
 305       $class->_upgrade_schema(%opt);
 306
 307       if ( $oldAutoCommit ) {
 308         warn "  committing\n";
 309         dbh->commit or die dbh->errstr;
 310       }
 311
 312       #warn "\e[1K\rUpgrading $table... done in ". (time-$start). " seconds\n";
 313       warn "  done in ". (time-$start). " seconds\n";
 314
 315     } else {
 316       warn "WARNING: asked for schema upgrade of $table,".
 317            " but FS::$table has no _upgrade_schema method\n";
 318     }
 319
 320   }
 321
 322 }
 323
 324 =item upgrade_schema_data
 325
 326 =cut
 327
 328 sub upgrade_schema_data {
 329   my %opt = @_;
 330
 331   tie my %hash, 'Tie::IxHash',
 332
 333     #fix classnum character(1)
 334     'cust_bill_pkg_detail' => [],
 335     #add necessary columns to RT schema
 336     'TicketSystem' => [],
 337
 338   ;
 339
 340   \%hash;
 341
 342 }
 343
 344 sub upgrade_sqlradius {
 345   #my %opt = @_;
 346
 347   my $conf = new FS::Conf;
 348
 349   my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting();
 350
 351   foreach my $part_export ( @part_export ) {
 352
 353     my $errmsg = 'Error adding FreesideStatus to '.
 354                  $part_export->option('datasrc'). ': ';
 355
 356     my $dbh = DBI->connect(
 357       ( map $part_export->option($_), qw ( datasrc username password ) ),
 358       { PrintError => 0, PrintWarn => 0 }
 359     ) or do {
 360       warn $errmsg.$DBI::errstr;
 361       next;
 362     };
 363
 364     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 365     my $group = "UserName";
 366     $group .= ",Realm"
 367       if ref($part_export) =~ /withdomain/
 368       || $dbh->{Driver}->{Name} =~ /^Pg/; #hmm
 369
 370     my $sth_alter = $dbh->prepare(
 371       "ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL"
 372     );
 373     if ( $sth_alter ) {
 374       if ( $sth_alter->execute ) {
 375         my $sth_update = $dbh->prepare(
 376          "UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL"
 377         ) or die $errmsg.$dbh->errstr;
 378         $sth_update->execute or die $errmsg.$sth_update->errstr;
 379       } else {
 380         my $error = $sth_alter->errstr;
 381         warn $errmsg.$error
 382           unless $error =~ /Duplicate column name/i  #mysql
 383               || $error =~ /already exists/i;        #Pg
 384 ;
 385       }
 386     } else {
 387       my $error = $dbh->errstr;
 388       warn $errmsg.$error; #unless $error =~ /exists/i;
 389     }
 390
 391     my $sth_index = $dbh->prepare(
 392       "CREATE INDEX FreesideStatus ON radacct ( FreesideStatus )"
 393     );
 394     if ( $sth_index ) {
 395       unless ( $sth_index->execute ) {
 396         my $error = $sth_index->errstr;
 397         warn $errmsg.$error
 398           unless $error =~ /Duplicate key name/i #mysql
 399               || $error =~ /already exists/i;    #Pg
 400       }
 401     } else {
 402       my $error = $dbh->errstr;
 403       warn $errmsg.$error. ' (preparing statement)';#unless $error =~ /exists/i;
 404     }
 405
 406     my $times = ($dbh->{Driver}->{Name} =~ /^mysql/)
 407       ? ' AcctStartTime != 0 AND AcctStopTime != 0 '
 408       : ' AcctStartTime IS NOT NULL AND AcctStopTime IS NOT NULL ';
 409
 410     my $sth = $dbh->prepare("SELECT UserName,
 411                                     Realm,
 412                                     $str2time max(AcctStartTime)),
 413                                     $str2time max(AcctStopTime))
 414                               FROM radacct
 415                               WHERE FreesideStatus = 'done'
 416                                 AND $times
 417                               GROUP BY $group
 418                             ")
 419       or die $errmsg.$dbh->errstr;
 420     $sth->execute() or die $errmsg.$sth->errstr;
 421
 422     while (my $row = $sth->fetchrow_arrayref ) {
 423       my ($username, $realm, $start, $stop) = @$row;
 424
 425       $username = lc($username) unless $conf->exists('username-uppercase');
 426
 427       my $exportnum = $part_export->exportnum;
 428       my $extra_sql = " AND exportnum = $exportnum ".
 429                       " AND exportsvcnum IS NOT NULL ";
 430
 431       if ( ref($part_export) =~ /withdomain/ ) {
 432         $extra_sql = " AND '$realm' = ( SELECT domain FROM svc_domain
 433                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
 434       }
 435
 436       my $svc_acct = qsearchs({
 437         'select'    => 'svc_acct.*',
 438         'table'     => 'svc_acct',
 439         'addl_from' => 'LEFT JOIN cust_svc   USING ( svcnum )'.
 440                        'LEFT JOIN export_svc USING ( svcpart )',
 441         'hashref'   => { 'username' => $username },
 442         'extra_sql' => $extra_sql,
 443       });
 444
 445       if ($svc_acct) {
 446         $svc_acct->last_login($start)
 447           if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login);
 448         $svc_acct->last_logout($stop)
 449           if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout);
 450       }
 451     }
 452   }
 453
 454 }
 455
 456 =back
 457
 458 =head1 BUGS
 459
 460 Sure.
 461
 462 =head1 SEE ALSO
 463
 464 =cut
 465
 466 1;
 467