Revision 0b280f98
Von Moritz Bunkus vor mehr als 17 Jahren hinzugefügt
| SL/User.pm | ||
|---|---|---|
| 40 | 40 |
use SL::DBUpgrade2; |
| 41 | 41 |
use SL::DBUtils; |
| 42 | 42 |
use SL::Iconv; |
| 43 |
use SL::Inifile; |
|
| 43 | 44 |
|
| 44 | 45 |
sub new {
|
| 45 | 46 |
$main::lxdebug->enter_sub(); |
| ... | ... | |
| 666 | 667 |
|
| 667 | 668 |
my ($self, $form) = @_; |
| 668 | 669 |
|
| 669 |
my %dbsources = (); |
|
| 670 |
my $query; |
|
| 671 |
|
|
| 672 |
$form->{sid} = $form->{dbdefault};
|
|
| 673 |
&dbconnect_vars($form, $form->{dbdefault});
|
|
| 674 |
|
|
| 675 |
my $dbh = |
|
| 676 |
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
|
| 677 |
or $form->dberror; |
|
| 678 |
|
|
| 679 |
if ($form->{dbdriver} eq 'Pg') {
|
|
| 670 |
my $members = Inifile->new($main::memberfile); |
|
| 671 |
my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
|
|
| 680 | 672 |
|
| 681 |
$query = |
|
| 682 |
qq|SELECT d.datname FROM pg_database d, pg_user u | . |
|
| 683 |
qq|WHERE d.datdba = u.usesysid AND u.usename = ?|; |
|
| 684 |
my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser});
|
|
| 673 |
my ($query, $sth, %dbs_needing_updates); |
|
| 685 | 674 |
|
| 686 |
while (my ($db) = $sth->fetchrow_array) {
|
|
| 675 |
foreach my $login (grep /[a-z]/, keys %{ $members }) {
|
|
| 676 |
my $member = $members->{$login};
|
|
| 687 | 677 |
|
| 688 |
next if ($db =~ /^template/); |
|
| 678 |
map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
|
|
| 679 |
dbconnect_vars($form, $form->{dbname});
|
|
| 680 |
$main::lxdebug->dump(0, "form", $form); |
|
| 681 |
my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
|
|
| 689 | 682 |
|
| 690 |
&dbconnect_vars($form, $db);
|
|
| 683 |
next unless $dbh;
|
|
| 691 | 684 |
|
| 692 |
my $dbh2 = |
|
| 693 |
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
|
| 694 |
or $form->dberror; |
|
| 685 |
my $version; |
|
| 695 | 686 |
|
| 696 |
$query = |
|
| 697 |
qq|SELECT tablename FROM pg_tables | . |
|
| 698 |
qq|WHERE tablename = 'defaults'|; |
|
| 699 |
my $sth2 = prepare_execute_query($form, $dbh, $query); |
|
| 700 |
|
|
| 701 |
if ($sth2->fetchrow_array) {
|
|
| 702 |
$query = qq|SELECT version FROM defaults|; |
|
| 703 |
my ($version) = selectrow_query($form, $dbh2, $query); |
|
| 704 |
$dbsources{$db} = $version;
|
|
| 705 |
} |
|
| 706 |
$sth2->finish; |
|
| 707 |
$dbh2->disconnect; |
|
| 687 |
$query = qq|SELECT version FROM defaults|; |
|
| 688 |
$sth = prepare_query($form, $dbh, $query); |
|
| 689 |
if ($sth->execute()) {
|
|
| 690 |
($version) = $sth->fetchrow_array(); |
|
| 708 | 691 |
} |
| 709 |
$sth->finish; |
|
| 710 |
} |
|
| 711 |
|
|
| 712 |
if ($form->{dbdriver} eq 'Oracle') {
|
|
| 713 |
$query = |
|
| 714 |
qq|SELECT owner FROM dba_objects |. |
|
| 715 |
qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|; |
|
| 716 |
|
|
| 717 |
$sth = $dbh->prepare($query); |
|
| 718 |
$sth->execute || $form->dberror($query); |
|
| 719 |
|
|
| 720 |
while (my ($db) = $sth->fetchrow_array) {
|
|
| 721 |
|
|
| 722 |
$form->{dbuser} = $db;
|
|
| 723 |
&dbconnect_vars($form, $db); |
|
| 724 |
|
|
| 725 |
my $dbh = |
|
| 726 |
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
|
| 727 |
or $form->dberror; |
|
| 692 |
$sth->finish(); |
|
| 693 |
$dbh->disconnect(); |
|
| 728 | 694 |
|
| 729 |
$query = qq|SELECT version FROM defaults|; |
|
| 730 |
my $sth = $dbh->prepare($query); |
|
| 731 |
$sth->execute; |
|
| 695 |
next unless $version; |
|
| 732 | 696 |
|
| 733 |
if (my ($version) = $sth->fetchrow_array) {
|
|
| 734 |
$dbsources{$db} = $version;
|
|
| 735 |
} |
|
| 736 |
$sth->finish; |
|
| 737 |
$dbh->disconnect; |
|
| 697 |
if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
|
|
| 698 |
my $dbinfo = {};
|
|
| 699 |
map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
|
|
| 700 |
$dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
|
|
| 738 | 701 |
} |
| 739 |
$sth->finish; |
|
| 740 | 702 |
} |
| 741 | 703 |
|
| 742 |
$dbh->disconnect; |
|
| 743 |
|
|
| 744 | 704 |
$main::lxdebug->leave_sub(); |
| 745 | 705 |
|
| 746 |
return %dbsources;
|
|
| 706 |
return values %dbs_needing_updates;
|
|
| 747 | 707 |
} |
| 748 | 708 |
|
| 749 | 709 |
sub calc_version {
|
| ... | ... | |
| 793 | 753 |
|
| 794 | 754 |
local *SQLDIR; |
| 795 | 755 |
|
| 796 |
opendir(SQLDIR, "sql/${dbdriver}-upgrade")
|
|
| 797 |
or &error("", "sql/${dbdriver}-upgrade: $!");
|
|
| 798 |
my @upgradescripts = |
|
| 799 |
grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/,
|
|
| 800 |
readdir(SQLDIR)); |
|
| 801 |
closedir(SQLDIR); |
|
| 756 |
opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
|
|
| 757 |
my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
|
|
| 758 |
closedir SQLDIR; |
|
| 802 | 759 |
|
| 803 | 760 |
return ($#upgradescripts > -1); |
| 804 | 761 |
} |
| ... | ... | |
| 940 | 897 |
|
| 941 | 898 |
map({ $_->{"applied"} = 0; } @upgradescripts);
|
| 942 | 899 |
|
| 900 |
$self->create_schema_info_table($form, $dbh); |
|
| 901 |
|
|
| 943 | 902 |
$query = qq|SELECT tag FROM schema_info|; |
| 944 | 903 |
$sth = $dbh->prepare($query); |
| 945 | 904 |
$sth->execute() || $form->dberror($query); |
Auch abrufbar als: Unified diff
Administration: Die Funktion zur Aktualisierung von nicht aktuellen Datenbanken neu geschrieben und wieder aktiviert. Unterstützt auch die Scripte in Pg-upgrade2.