fix DBI connection, RT#39250
[freeside.git] / FS / bin / freeside-upgrade
1 #!/usr/bin/perl -w
2
3 use strict;
4 use vars qw( $opt_d $opt_s $opt_q $opt_v $opt_r $opt_c $opt_j $opt_a );
5 use vars qw( $DEBUG $DRY_RUN );
6 use Getopt::Std;
7 use DBD::Pg qw(:async); #for -a
8 use DBIx::DBSchema 0.31; #0.39
9 use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name);
10 use FS::CurrentUser;
11 use FS::Schema qw( dbdef dbdef_dist reload_dbdef );
12 use FS::Misc::prune qw(prune_applications);
13 use FS::Conf;
14 use FS::Record qw(qsearch);
15 use FS::Upgrade qw(upgrade_schema upgrade_config upgrade upgrade_sqlradius);
16
17 my $start = time;
18
19 die "Not running uid freeside!" unless checkeuid();
20
21 getopts("dqrcsja");
22
23 $DEBUG = !$opt_q;
24 #$DEBUG = $opt_v;
25
26 $DRY_RUN = $opt_d;
27
28 my $user = shift or die &usage;
29 $FS::CurrentUser::upgrade_hack = 1;
30 $FS::UID::callback_hack = 1;
31 my $dbh = adminsuidsetup($user);
32 $FS::UID::callback_hack = 0;
33
34 # pass command line opts through to upgrade* routines
35 my %upgrade_opts = (
36   quiet   => $opt_q,
37   verbose => $opt_v,
38   queue   => $opt_j,
39   # others?
40 );
41
42 if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above
43   eval "use DBIx::DBSchema 0.39;";
44   die $@ if $@;
45 }
46
47 #needs to match FS::Schema...
48 my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc;
49
50 dbdef_create($dbh, $dbdef_file);
51
52 delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
53 reload_dbdef($dbdef_file);
54
55 warn "Upgrade startup completed in ". (time-$start). " seconds\n"; # if $DEBUG;
56 $start = time;
57
58 #$DBIx::DBSchema::DEBUG = $DEBUG;
59 #$DBIx::DBSchema::Table::DEBUG = $DEBUG;
60 #$DBIx::DBSchema::Index::DEBUG = $DEBUG;
61
62 my @bugfix = ();
63
64 if (dbdef->table('cust_main')->column('agent_custid') && ! $opt_s) { 
65   push @bugfix,
66     "UPDATE cust_main SET agent_custid = NULL where agent_custid = ''";
67
68   push @bugfix,
69     "UPDATE h_cust_main SET agent_custid = NULL where agent_custid = ''"
70       if (dbdef->table('h_cust_main')); 
71 }
72
73 if ( dbdef->table('cgp_rule_condition') &&
74      dbdef->table('cgp_rule_condition')->column('condition') 
75    )
76 {
77   push @bugfix,
78    "ALTER TABLE ${_}cgp_rule_condition RENAME COLUMN condition TO conditionname"
79       for '', 'h_';
80
81 }
82
83 if ( dbdef->table('areacode') and
84      dbdef->table('areacode')->primary_key eq 'code' )
85 {
86   if ( driver_name =~ /^mysql/i ) {
87     push @bugfix, 
88       'ALTER TABLE areacode DROP PRIMARY KEY',
89       'ALTER TABLE areacode ADD COLUMN (areanum int auto_increment primary key)';
90   }
91   else {
92     push @bugfix, 'ALTER TABLE areacode DROP CONSTRAINT areacode_pkey';
93   }
94 }
95
96 if ( dbdef->table('upgrade_journal') ) {
97   if ( driver_name =~ /^Pg/i ) {
98     push @bugfix, "
99       SELECT SETVAL( 'upgrade_journal_upgradenum_seq',
100                      ( SELECT MAX(upgradenum) FROM upgrade_journal )
101                    )
102     ";
103   #MySQL can't do this in a statement so have to do it manually
104   #} elsif ( driver_name =~ /^mysql/i ) {
105   #  push @bugfix, "
106   #     ALTER TABLE upgrade_journal AUTO_INCREMENT =
107   #                 ( ( SELECT MAX(upgradenum) FROM upgrade_journal ) + 1 )
108   #  ";
109   }
110 }
111
112 if ( $DRY_RUN ) {
113   print
114     join(";\n", @bugfix ). ";\n";
115 } elsif ( @bugfix ) {
116
117   foreach my $statement ( @bugfix ) {
118     warn "$statement\n";
119     $dbh->do( $statement )
120       or die "Error: ". $dbh->errstr. "\n executing: $statement";
121   }
122
123   upgrade_schema(%upgrade_opts);
124
125   dbdef_create($dbh, $dbdef_file);
126   delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
127   reload_dbdef($dbdef_file);
128
129 }
130
131 #you should have run fs-migrate-part_svc ages ago, when you upgraded
132 #from 1.3 to 1.4... if not, it needs to be hooked into -upgrade here or
133 #you'll lose all the part_svc settings it migrates to part_svc_column
134
135 my $conf = new FS::Conf;
136
137 my $dbdef_dist = dbdef_dist(
138   datasrc,
139   { 'queue-no_history' => $conf->exists('queue-no_history') },
140 );
141
142 my @statements = dbdef->sql_update_schema( $dbdef_dist,
143                                            $dbh,
144                                            { 'nullify_default' => 1, },
145                                          );
146
147 #### NEW CUSTOM FIELDS:
148 # 1. prevent new custom field columns from being dropped by upgrade
149 # 2. migrate old virtual fields to real fields (new custom fields)
150 ####
151 my $cfsth = $dbh->prepare("SELECT * FROM part_virtual_field") 
152                                                          or die $dbh->errstr;
153 $cfsth->execute or die $cfsth->errstr;
154 my $cf; 
155 while ( $cf = $cfsth->fetchrow_hashref ) {
156     my $tbl = $cf->{'dbtable'};
157     my $name = $cf->{'name'};
158     $name = lc($name) unless driver_name =~ /^mysql/i;
159
160     @statements = grep { $_ !~ /^\s*ALTER\s+TABLE\s+(h_|)$tbl\s+DROP\s+COLUMN\s+cf_$name\s*$/i }
161                                                                     @statements;
162     push @statements, 
163         "ALTER TABLE $tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
164      unless (dbdef->table($tbl) && dbdef->table($tbl)->column("cf_$name"));
165     push @statements, 
166         "ALTER TABLE h_$tbl ADD COLUMN cf_$name varchar(".$cf->{'length'}.")"
167      unless (dbdef->table("h_$tbl") && dbdef->table("h_$tbl")->column("cf_$name"));
168 }
169 warn "Custom fields schema upgrade completed";
170
171 @statements = 
172   grep { $_ !~ /^CREATE +INDEX +h_queue/i } #useless, holds up queue insertion
173        @statements;
174
175 unless ( driver_name =~ /^mysql/i ) {
176   #not necessary under non-mysql, takes forever on big db
177   @statements =
178     grep { $_ !~ /^ *ALTER +TABLE +h_queue +ALTER +COLUMN +job +TYPE +varchar\(512\) *$/i }
179          @statements;
180 }
181
182 if ( $opt_c ) {
183
184   @statements =
185     grep { $_ !~ /^ *ALTER +TABLE +(h_)?cdr /i }
186          @statements;
187
188   @statements =
189     grep { $_ !~ /^ *CREATE +INDEX +(h_)?cdr\d+ /i }
190          @statements;
191
192 }
193
194 my $MAX_HANDLES; # undef for now, set it if you want a limit
195
196 if ( $DRY_RUN ) {
197   print
198     join(";\n", @statements ). ";\n";
199   exit;
200 } elsif ( $opt_a ) {
201
202   my @phases = map { [] } 0..4;
203   my $fsupgrade_idx = 1;
204   my %idx_map;
205   foreach (@statements) {
206     if ( /^ *(CREATE|ALTER) +TABLE/ ) {
207       # phase 0: CREATE TABLE, ALTER TABLE
208       push @{ $phases[0] }, $_;
209     } elsif ( /^ *ALTER +INDEX.* RENAME TO dbs_temp(\d+)/ ) {
210       # phase 1: rename index to dbs_temp%d
211       # (see DBIx::DBSchema::Table)
212       # but in this case, uniqueify all the dbs_temps.  This method only works
213       # because they are in the right order to begin with...
214       my $dbstemp_idx = $1;
215       s/dbs_temp$dbstemp_idx/fsupgrade_temp$fsupgrade_idx/;
216       $idx_map{ $dbstemp_idx } = $fsupgrade_idx;
217       push @{ $phases[1] }, $_;
218       $fsupgrade_idx++;
219     } elsif ( /^ *(CREATE|DROP)( +UNIQUE)? +INDEX/ ) {
220       # phase 2: create/drop indices
221       push @{ $phases[2] }, $_;
222     } elsif ( /^ *ALTER +INDEX +dbs_temp(\d+) +RENAME/ ) {
223       # phase 3: rename temp indices back to real ones
224       my $dbstemp_idx = $1;
225       my $mapped_idx = $idx_map{ $dbstemp_idx }
226         or die "unable to remap dbs_temp$1 RENAME statement";
227       s/dbs_temp$dbstemp_idx/fsupgrade_temp$mapped_idx/;
228       push @{ $phases[3] }, $_;
229     } else {
230       # phase 4: everything else (CREATE SEQUENCE, SELECT SETVAL, etc.)
231       push @{ $phases[4] }, $_;
232     }
233   }
234   my $i = 0;
235   my @busy = ();
236   my @free = ();
237   foreach my $phase (@phases) {
238     warn "Starting schema changes, phase $i...\n";
239     while (@$phase or @busy) {
240       # check status of all running tasks
241       my @newbusy;
242       my $failed_clone;
243       for my $clone (@busy) {
244         if ( $clone->pg_ready ) {
245           # then clean it up
246           my $rv = $clone->pg_result && $clone->commit;
247           $failed_clone = $clone if !$rv;
248           push @free, $clone;
249         } else {
250           push @newbusy, $clone;
251         }
252       }
253       if ( $failed_clone ) {
254         my $errstr = $failed_clone->errstr;
255         foreach my $clone (@newbusy, $failed_clone) {
256           $clone->pg_cancel if $clone->{pg_async_status} == 1;
257           $clone->disconnect;
258         }
259         die "$errstr\n";
260       }
261       @busy = @newbusy;
262       if (my $statement = $phase->[0]) {
263         my $clone;
264         if ( @free ) {
265           $clone = shift(@free);
266         } elsif ( !$MAX_HANDLES or 
267                   scalar(@free) + scalar(@busy) < $MAX_HANDLES ) {
268           $clone = $dbh->clone; # this will fail if over the server limit
269         }
270
271         if ( $clone ) {
272           my $rv = $clone->do($statement, {pg_async => PG_ASYNC});
273           if ( $rv ) {
274             warn "$statement\n";
275             shift @{ $phase }; # and actually take the statement off the queue
276             push @busy, $clone;
277           } # else I don't know, wait and retry
278         } # else too many handles, wait and retry
279       } elsif (@busy) {
280         # all statements are dispatched
281         warn "Waiting for phase $i to complete\n";
282         sleep 30;
283       }
284     } # while @$phase or @busy
285     $i++;
286   } # foreach $phase
287   warn "Schema changes complete.\n";
288
289 #  warn "Pre-schema change upgrades completed in ". (time-$start). " seconds\n"; # if $DEBUG;
290 #  $start = time;
291
292 #  dbdef->update_schema( dbdef_dist(datasrc), $dbh );
293 } else { # normal case, run statements sequentially
294   foreach my $statement ( @statements ) {
295     warn "$statement\n";
296     $dbh->do( $statement )
297       or die "Error: ". $dbh->errstr. "\n executing: $statement";
298   }
299 }
300
301 warn "Schema upgrade completed in ". (time-$start). " seconds\n"; # if $DEBUG;
302 $start = time;
303
304 my $hashref = {};
305 $hashref->{dry_run} = 1 if $DRY_RUN;
306 $hashref->{debug} = 1 if $DEBUG && $DRY_RUN;
307 prune_applications($hashref) unless $opt_s;
308
309 warn "Application pruning completed in ". (time-$start). " seconds\n"; # if $DEBUG;
310 $start = time;
311
312 print "\n" if $DRY_RUN;
313
314 if ( $dbh->{Driver}->{Name} =~ /^mysql/i && ! $opt_s ) {
315
316   foreach my $table (qw( svc_acct svc_phone )) {
317
318     my $sth = $dbh->prepare(
319       "SELECT COUNT(*) FROM duplicate_lock WHERE lockname = '$table'"
320     ) or die $dbh->errstr;
321
322     $sth->execute or die $sth->errstr;
323
324     unless ( $sth->fetchrow_arrayref->[0] ) {
325
326       $sth = $dbh->prepare(
327         "INSERT INTO duplicate_lock ( lockname ) VALUES ( '$table' )"
328       ) or die $dbh->errstr;
329
330       $sth->execute or die $sth->errstr;
331
332     }
333
334   }
335
336   warn "Duplication lock creation completed in ". (time-$start). " seconds\n"; # if $DEBUG;
337   $start = time;
338
339 }
340
341 $dbh->commit or die $dbh->errstr;
342
343 dbdef_create($dbh, $dbdef_file);
344
345 $dbh->disconnect or die $dbh->errstr;
346
347 delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
348 $FS::UID::AutoCommit = 0;
349 $FS::UID::callback_hack = 1;
350 $dbh = adminsuidsetup($user);
351 $FS::UID::callback_hack = 0;
352 unless ( $DRY_RUN || $opt_s ) {
353   my $dir = "%%%FREESIDE_CONF%%%/conf.". datasrc;
354   if (!scalar(qsearch('conf', {}))) {
355     my $error = FS::Conf::init_config($dir);
356     if ($error) {
357       warn "CONFIGURATION UPGRADE FAILED\n";
358       $dbh->rollback or die $dbh->errstr;
359       die $error;
360     }
361   }
362 }
363 $dbh->commit or die $dbh->errstr;
364 $dbh->disconnect or die $dbh->errstr;
365
366 $FS::UID::AutoCommit = 1;
367
368 $dbh = adminsuidsetup($user);
369
370 warn "Re-initialization with updated schema completed in ". (time-$start). " seconds\n"; # if $DEBUG;
371 $start = time;
372
373 #### NEW CUSTOM FIELDS:
374 # 3. migrate old virtual field data to the new custom fields
375 ####
376 $cfsth = $dbh->prepare("SELECT * FROM virtual_field left join part_virtual_field using (vfieldpart)")
377                                                          or die $dbh->errstr;
378 $cfsth->execute or die $cfsth->errstr;
379 my @cfst;
380 while ( $cf = $cfsth->fetchrow_hashref ) {
381     my $tbl = $cf->{'dbtable'};
382     my $name = $cf->{'name'};
383     my $dtable = dbdef->table($tbl);
384     next unless $dtable && $dtable->primary_key; # XXX: warn first?
385     my $pkey = $dtable->primary_key;
386     next unless $dtable->column($pkey)->type =~ /int/i; # XXX: warn first?
387     push @cfst, "UPDATE $tbl set cf_$name = '".$cf->{'value'}."' WHERE $pkey = ".$cf->{'recnum'};
388     push @cfst, "DELETE FROM virtual_field WHERE vfieldnum = ".$cf->{'vfieldnum'};
389 }
390 foreach my $cfst ( @cfst ) {
391     warn "$cfst\n";
392     $dbh->do( $cfst )
393       or die "Error: ". $dbh->errstr. "\n executing: $cfst";
394 }
395 warn "Custom fields data upgrade completed";
396
397 upgrade_config(%upgrade_opts)
398   unless $DRY_RUN || $opt_s;
399
400 $dbh->commit or die $dbh->errstr;
401
402 warn "Config updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
403 $start = time;
404
405 upgrade(%upgrade_opts)
406   unless $DRY_RUN || $opt_s;
407
408 $dbh->commit or die $dbh->errstr;
409
410 warn "Table updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
411 $start = time;
412
413 upgrade_sqlradius(%upgrade_opts)
414   unless $DRY_RUN || $opt_s || $opt_r;
415
416 warn "SQL RADIUS updates completed in ". (time-$start). " seconds\n"; # if $DEBUG;
417 $start = time;
418
419 $dbh->commit or die $dbh->errstr;
420 $dbh->disconnect or die $dbh->errstr;
421
422 warn "Final commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG;
423
424 ###
425
426 sub dbdef_create { # reverse engineer the schema from the DB and save to file
427   my( $dbh, $file ) = @_;
428   my $dbdef = new_native DBIx::DBSchema $dbh;
429   $dbdef->save($file);
430 }
431
432 sub usage {
433   die "Usage:\n  freeside-upgrade [ -d ] [ -q | -v ] [ -r ] [ -c ] [ -s ] [ -j ] [ -a ] user\n"; 
434 }
435
436 =head1 NAME
437
438 freeside-upgrade - Upgrades database schema for new freeside verisons.
439
440 =head1 SYNOPSIS
441
442   freeside-upgrade [ -d ] [ -q | -v ] [ -r ] [ -c ] [ -s ] [ -j ] [ -a ]
443
444 =head1 DESCRIPTION
445
446 Reads your existing database schema and updates it to match the current schema,
447 adding any columns or tables necessary.
448
449 Also performs other upgrade functions:
450
451 =over 4
452
453 =item Calls FS:: Misc::prune::prune_applications (probably unnecessary every upgrade, but simply won't find any records to change)
454
455 =item If necessary, moves your configuration information from the filesystem in /usr/local/etc/freeside/conf.<datasrc> to the database.
456
457 =back
458
459   [ -d ]: Dry run; output SQL statements (to STDOUT) only, but do not execute
460           them.
461
462   [ -q ]: Run quietly.  This may become the default at some point.
463
464   [ -v ]: Run verbosely, sending debugging information to STDERR.  This is the
465           current default.
466
467   [ -s ]: Schema changes only.  Useful for Pg/slony slaves where the data
468           changes will be replicated from the Pg/slony master.
469
470   [ -r ]: Skip sqlradius updates.  Useful for occassions where the sqlradius
471           databases may be inaccessible.
472
473   [ -c ]: Skip cdr and h_cdr updates.
474
475   [ -j ]: Run certain upgrades asychronously from the job queue.  Currently 
476           used only for the 2.x -> 3.x cust_location, cust_pay and part_pkg
477           upgrades.  This may cause odd behavior before the upgrade is
478           complete, so it's recommended only for very large cust_main, cust_pay
479           and/or part_pkg tables that take too long to upgrade.
480
481   [ -a ]: Run schema changes in parallel (Pg only).  DBIx::DBSchema minimum 
482           version 0.41 recommended.  Recommended only for large databases and
483           powerful database servers, to reduce upgrade time.
484
485 =head1 SEE ALSO
486
487 =cut
488