match hyphens in doclink formatting removal
[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
13 my $tl = $dbh->prepare("show tables")
14   or die "prepare show tables ",$dbh->errstr;
15 $tl->execute
16   or die "execute show tables ",$tl->errstr;
17 # cleanup first
18 my @drop_tables;
19 while (my $row = $tl->fetchrow_arrayref) {
20   push(@drop_tables, $row->[0]);
21 }
22 undef $tl;
23 my %tables = map { $_ => 1 } @drop_tables;
24 my $error;
25 my $dropped = 1;
26 # need this loop to handle references between tables restricting us
27 # from dropping them
28 while ($dropped && keys %tables) {
29   my $dropped = 0;
30   my @tables = keys %tables;
31   for my $drop (@tables) { # not keys %tables, since we modify it
32     if ($dbh->do("drop table $drop")) {
33       ++$dropped;
34       delete $tables{$drop};
35     }
36     else {
37       $error = "Could not drop old table: ". $dbh->errstr;
38     }
39   }
40 }
41 if (keys %tables) {
42   print "Could not drop bsebuilder tables:\n   ", join("\n  ", sort keys %tables), "\n";
43   die $error;
44 }
45
46 system "mysql -u$un -p$pw $db <$dist"
47   and die "Error loading database";
48
49 $tl = $dbh->prepare("show table status")
50   or die "prepare show table status ",$dbh->errstr;
51 $tl->execute
52   or die "execute show table status ",$tl->errstr;
53 my @tables;
54 my %engines;
55 while (my $row = $tl->fetchrow_arrayref) {
56   push(@tables, $row->[0]);
57   $engines{$row->[0]} = $row->[1];
58 }
59 undef $tl;
60
61 my @expected = qw(field type null key default extra);
62 my @want =     qw(field type null default extra);
63 for my $table (@tables) {
64   print "Table $table\n";
65   print "Engine $engines{$table}\n";
66   my $ti = $dbh->prepare("describe $table")
67     or die "prepare describe $table: ",$dbh->errstr;
68   $ti->execute()
69     or die "execute describe $table: ",$dbh->errstr;
70   my @names = @{$ti->{NAME_lc}};
71   my %names;
72   @names{@names} = 0..$#names;
73   for my $name (@expected) {
74     exists $names{$name}
75       or die "Didn't find expected field $name in describe table $table";
76   }
77   while (my $row = $ti->fetchrow_arrayref) {
78     for my $name (@want) {
79       defined $row->[$names{$name}] or $row->[$names{$name}] = "NULL";
80       if ($name eq 'type' && 
81           $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
82         $row->[$names{$name}] = "varbinary($1)";
83       }
84     }
85     print "Column ",join(";",@$row[@names{@want}]),
86     "\n";
87   }
88   undef $ti;
89   my $ii = $dbh->prepare("show index from $table")
90     or die "prepare show index from $table: ",$dbh->errstr;
91   $ii->execute()
92     or die "execute show index from $table: ",$dbh->errstr;
93   my %indices;
94   my %unique;
95   while (my $row = $ii->fetchrow_hashref("NAME_lc")) {
96     push(@{$indices{$row->{key_name}}}, 
97          [ $row->{column_name}, $row->{seq_in_index} ]);
98     $unique{$row->{key_name}} = 0 + !$row->{non_unique};
99   }
100   #use Data::Dumper;
101   #print Dumper(\%indices);
102   for my $index (sort keys %indices) {
103     my @sorted = sort { $a->[1] <=> $b->[1] } @{$indices{$index}};
104     print "Index $index;$unique{$index};[",
105       join(";", map $_->[0], @sorted),
106       "]\n";
107   }
108 }
109
110 $dbh->disconnect;