prevent noise when removing old tables
[bse.git] / schema / mysql_build.pl
1 #!perl -w
2 # Builds a dump of the database structure suitable for use by upgrade_mysql.pl
3 use DBI;
4 use strict;
5 my $db = 'bsebuilder';
6 my $un = 'bsebuilder';
7 my $pw = 'bsebuilder';
8 my $dist = shift || "schema/bse.sql";
9
10 my $dbh = DBI->connect("dbi:mysql:$db", $un, $pw)
11   or die "Cannot connect to db: ",DBI->errstr;
12 $dbh->{PrintError} = 0; # we report our own errors
13
14 my $tl = $dbh->prepare("show tables")
15   or die "prepare show tables ",$dbh->errstr;
16 $tl->execute
17   or die "execute show tables ",$tl->errstr;
18 # cleanup first
19 my @drop_tables;
20 while (my $row = $tl->fetchrow_arrayref) {
21   push(@drop_tables, $row->[0]);
22 }
23 undef $tl;
24 my %tables = map { $_ => 1 } @drop_tables;
25 my $error;
26 my $dropped = 1;
27 # need this loop to handle references between tables restricting us
28 # from dropping them
29 while ($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 }
42 if (keys %tables) {
43   print "Could not drop bsebuilder tables:\n   ", join("\n  ", sort keys %tables), "\n";
44   die $error;
45 }
46
47 system "mysql -u$un -p$pw $db <$dist"
48   and die "Error loading database";
49
50 $tl = $dbh->prepare("show table status")
51   or die "prepare show table status ",$dbh->errstr;
52 $tl->execute
53   or die "execute show table status ",$tl->errstr;
54 my @tables;
55 my %engines;
56 while (my $row = $tl->fetchrow_arrayref) {
57   push(@tables, $row->[0]);
58   $engines{$row->[0]} = $row->[1];
59 }
60 undef $tl;
61
62 my @expected = qw(field type null key default extra);
63 my @want =     qw(field type null default extra);
64 for my $table (@tables) {
65   print "Table $table\n";
66   print "Engine $engines{$table}\n";
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";
81       if ($name eq 'type' && 
82           $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
83         $row->[$names{$name}] = "varbinary($1)";
84       }
85     }
86     print "Column ",join(";",@$row[@names{@want}]),
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}};
105     print "Index $index;$unique{$index};[",
106       join(";", map $_->[0], @sorted),
107       "]\n";
108   }
109 }
110
111 $dbh->disconnect;