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