prevent noise when removing old tables
[bse.git] / schema / mysql_build.pl
CommitLineData
2f003a93
TC
1#!perl -w
2# Builds a dump of the database structure suitable for use by upgrade_mysql.pl
3use DBI;
b19047a6 4use strict;
2f003a93
TC
5my $db = 'bsebuilder';
6my $un = 'bsebuilder';
7my $pw = 'bsebuilder';
dbc2ba69 8my $dist = shift || "schema/bse.sql";
2f003a93 9
b19047a6 10my $dbh = DBI->connect("dbi:mysql:$db", $un, $pw)
2f003a93 11 or die "Cannot connect to db: ",DBI->errstr;
88816f93 12$dbh->{PrintError} = 0; # we report our own errors
2f003a93 13
b19047a6
TC
14my $tl = $dbh->prepare("show tables")
15 or die "prepare show tables ",$dbh->errstr;
16$tl->execute
17 or die "execute show tables ",$tl->errstr;
abf5bbc6
TC
18# cleanup first
19my @drop_tables;
20while (my $row = $tl->fetchrow_arrayref) {
21 push(@drop_tables, $row->[0]);
22}
23undef $tl;
dbc2ba69
TC
24my %tables = map { $_ => 1 } @drop_tables;
25my $error;
26my $dropped = 1;
27# need this loop to handle references between tables restricting us
28# from dropping them
29while ($dropped && keys %tables) {
30 my $dropped = 0;
31 my @tables = keys %tables;
32 for my $drop (@tables) { # not keys %tables, since we modify it
33 if ($dbh->do("drop table $drop")) {
34 ++$dropped;
35 delete $tables{$drop};
36 }
37 else {
38 $error = "Could not drop old table: ". $dbh->errstr;
39 }
40 }
41}
42if (keys %tables) {
43 print "Could not drop bsebuilder tables:\n ", join("\n ", sort keys %tables), "\n";
44 die $error;
abf5bbc6
TC
45}
46
918735d1 47system "mysql -u$un -p$pw $db <$dist"
abf5bbc6
TC
48 and die "Error loading database";
49
bee8ef2b
TC
50$tl = $dbh->prepare("show table status")
51 or die "prepare show table status ",$dbh->errstr;
abf5bbc6 52$tl->execute
bee8ef2b 53 or die "execute show table status ",$tl->errstr;
b19047a6 54my @tables;
bee8ef2b 55my %engines;
b19047a6
TC
56while (my $row = $tl->fetchrow_arrayref) {
57 push(@tables, $row->[0]);
bee8ef2b 58 $engines{$row->[0]} = $row->[1];
b19047a6
TC
59}
60undef $tl;
2f003a93 61
b19047a6 62my @expected = qw(field type null key default extra);
85802bd5 63my @want = qw(field type null default extra);
b19047a6
TC
64for my $table (@tables) {
65 print "Table $table\n";
bee8ef2b 66 print "Engine $engines{$table}\n";
b19047a6
TC
67 my $ti = $dbh->prepare("describe $table")
68 or die "prepare describe $table: ",$dbh->errstr;
69 $ti->execute()
70 or die "execute describe $table: ",$dbh->errstr;
71 my @names = @{$ti->{NAME_lc}};
72 my %names;
73 @names{@names} = 0..$#names;
74 for my $name (@expected) {
75 exists $names{$name}
76 or die "Didn't find expected field $name in describe table $table";
77 }
78 while (my $row = $ti->fetchrow_arrayref) {
79 for my $name (@want) {
80 defined $row->[$names{$name}] or $row->[$names{$name}] = "NULL";
85802bd5
TC
81 if ($name eq 'type' &&
82 $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
83 $row->[$names{$name}] = "varbinary($1)";
84 }
b19047a6 85 }
dc872a32 86 print "Column ",join(";",@$row[@names{@want}]),
b19047a6
TC
87 "\n";
88 }
89 undef $ti;
90 my $ii = $dbh->prepare("show index from $table")
91 or die "prepare show index from $table: ",$dbh->errstr;
92 $ii->execute()
93 or die "execute show index from $table: ",$dbh->errstr;
94 my %indices;
95 my %unique;
96 while (my $row = $ii->fetchrow_hashref("NAME_lc")) {
97 push(@{$indices{$row->{key_name}}},
98 [ $row->{column_name}, $row->{seq_in_index} ]);
99 $unique{$row->{key_name}} = 0 + !$row->{non_unique};
100 }
101 #use Data::Dumper;
102 #print Dumper(\%indices);
103 for my $index (sort keys %indices) {
104 my @sorted = sort { $a->[1] <=> $b->[1] } @{$indices{$index}};
dc872a32
TC
105 print "Index $index;$unique{$index};[",
106 join(";", map $_->[0], @sorted),
b19047a6
TC
107 "]\n";
108 }
109}
110
111$dbh->disconnect;