+ print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
+ join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } values %{ $controls }) .
+ "\n\n";
+}
+
+sub apply_upgrade {
+ my $name = shift;
+
+ my (@order, %tags, @all_tags);
+
+ if ($name eq "ALL") {
+ calc_rev_depends();
+ @all_tags = map { $_->{tag} } grep { !@{$_->{rev_depends}} } values %{ $controls };
+
+ } else {
+ $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
+ @all_tags = ($name);
+ }
+
+ foreach my $tag (@all_tags) {
+ build_upgrade_order($tag, \@order, \%tags);
+ }
+
+ my @upgradescripts = map { $controls->{$_}->{applied} = 0; $controls->{$_} } @order;
+
+ my $dbh = $form->dbconnect_noauto(\%myconfig);
+
+ $dbh->{PrintWarn} = 0;
+ $dbh->{PrintError} = 0;
+
+ $user->create_schema_info_table($form, $dbh);
+
+ my $query = qq|SELECT tag FROM schema_info|;
+ $sth = $dbh->prepare($query);
+ $sth->execute() || $form->dberror($query);
+ while (($tag) = $sth->fetchrow_array()) {
+ $controls->{$tag}->{applied} = 1 if defined $controls->{$tag};
+ }
+ $sth->finish();
+
+ @upgradescripts = sort { $a->{priority} <=> $b->{priority} } grep { !$_->{applied} } @upgradescripts;
+ if (!@upgradescripts) {
+ print "The upgrade has already been applied.\n";
+ exit 0;
+ }
+
+ foreach my $control (@upgradescripts) {
+ $control->{file} =~ /\.(sql|pl)$/;
+ my $file_type = $1;
+
+ # apply upgrade
+ print "Applying upgrade $control->{file}\n";
+
+ if ($file_type eq "sql") {
+ $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
+ } else {
+ $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
+ }
+ }
+
+ $dbh->disconnect();
+}
+
+sub dump_sql_result {
+ my ($results, $column_order) = @_;
+
+ my %column_lengths = map { $_, length $_ } keys %{ $results->[0] };
+
+ foreach my $row (@{ $results }) {
+ map { $column_lengths{$_} = length $row->{$_} if (length $row->{$_} > $column_lengths{$_}) } keys %{ $row };
+ }
+
+ my @sorted_names;
+ if ($column_order && scalar @{ $column_order }) {
+ @sorted_names = @{ $column_order };
+ } else {
+ @sorted_names = sort keys %column_lengths;
+ }
+
+ my $format = join('|', map { '%-' . $column_lengths{$_} . 's' } @sorted_names) . "\n";
+
+ printf $format, @sorted_names;
+ print join('+', map { '-' x $column_lengths{$_} } @sorted_names) . "\n";
+
+ foreach my $row (@{ $results }) {
+ printf $format, map { $row->{$_} } @sorted_names;
+ }
+ printf "(\%d row\%s)\n", scalar @{ $results }, scalar @{ $results } > 1 ? 's' : '';
+}
+
+sub dump_applied {
+ my @results;
+
+ my $dbh = $form->dbconnect_noauto(\%myconfig);
+
+ $dbh->{PrintWarn} = 0;
+ $dbh->{PrintError} = 0;
+
+ $user->create_schema_info_table($form, $dbh);
+
+ my $query = qq|SELECT tag, login, itime FROM schema_info ORDER BY itime|;
+ $sth = $dbh->prepare($query);
+ $sth->execute() || $form->dberror($query);
+ while (my $ref = $sth->fetchrow_hashref()) {
+ push @results, $ref;
+ }
+ $sth->finish();
+
+ $dbh->disconnect();
+
+ if (!scalar @results) {
+ print "No database upgrades have been applied yet.\n";
+ } else {
+ dump_sql_result(\@results, [qw(tag login itime)]);
+ }
+}
+
+sub build_upgrade_order {
+ my $name = shift;
+ my $order = shift;
+ my $tag = shift;
+
+ my $control = $controls->{$name};
+
+ foreach my $dependency (@{ $control->{depends} }) {
+ next if $tags->{$dependency};
+ $tags->{$dependency} = 1;
+ build_upgrade_order($dependency, $order, $tag);
+ }
+
+ push @{ $order }, $name;
+ $tags->{$name} = 1;