support for new templating for product options
[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
TC
11 or die "Cannot connect to db: ",DBI->errstr;
12
b19047a6
TC
13my $tl = $dbh->prepare("show tables")
14 or die "prepare show tables ",$dbh->errstr;
15$tl->execute
16 or die "execute show tables ",$tl->errstr;
abf5bbc6
TC
17# cleanup first
18my @drop_tables;
19while (my $row = $tl->fetchrow_arrayref) {
20 push(@drop_tables, $row->[0]);
21}
22undef $tl;
dbc2ba69
TC
23my %tables = map { $_ => 1 } @drop_tables;
24my $error;
25my $dropped = 1;
26# need this loop to handle references between tables restricting us
27# from dropping them
28while ($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}
41if (keys %tables) {
42 print "Could not drop bsebuilder tables:\n ", join("\n ", sort keys %tables), "\n";
43 die $error;
abf5bbc6
TC
44}
45
918735d1 46system "mysql -u$un -p$pw $db <$dist"
abf5bbc6
TC
47 and die "Error loading database";
48
bee8ef2b
TC
49$tl = $dbh->prepare("show table status")
50 or die "prepare show table status ",$dbh->errstr;
abf5bbc6 51$tl->execute
bee8ef2b 52 or die "execute show table status ",$tl->errstr;
b19047a6 53my @tables;
bee8ef2b 54my %engines;
b19047a6
TC
55while (my $row = $tl->fetchrow_arrayref) {
56 push(@tables, $row->[0]);
bee8ef2b 57 $engines{$row->[0]} = $row->[1];
b19047a6
TC
58}
59undef $tl;
2f003a93 60
b19047a6 61my @expected = qw(field type null key default extra);
85802bd5 62my @want = qw(field type null default extra);
b19047a6
TC
63for my $table (@tables) {
64 print "Table $table\n";
bee8ef2b 65 print "Engine $engines{$table}\n";
b19047a6
TC
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";
85802bd5
TC
80 if ($name eq 'type' &&
81 $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
82 $row->[$names{$name}] = "varbinary($1)";
83 }
b19047a6 84 }
dc872a32 85 print "Column ",join(";",@$row[@names{@want}]),
b19047a6
TC
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}};
dc872a32
TC
104 print "Index $index;$unique{$index};[",
105 join(";", map $_->[0], @sorted),
b19047a6
TC
106 "]\n";
107 }
108}
109
110$dbh->disconnect;