]>
Commit | Line | Data |
---|---|---|
2f003a93 TC |
1 | #!perl -w |
2 | # Builds a dump of the database structure suitable for use by upgrade_mysql.pl | |
3 | use DBI; | |
b19047a6 | 4 | use strict; |
2f003a93 TC |
5 | my $db = 'bsebuilder'; |
6 | my $un = 'bsebuilder'; | |
7 | my $pw = 'bsebuilder'; | |
3f079195 | 8 | my $dist = "schema/bse.sql"; |
2f003a93 | 9 | |
b19047a6 | 10 | my $dbh = DBI->connect("dbi:mysql:$db", $un, $pw) |
2f003a93 TC |
11 | or die "Cannot connect to db: ",DBI->errstr; |
12 | ||
b19047a6 TC |
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; | |
abf5bbc6 TC |
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 | for my $drop (@drop_tables) { | |
24 | $dbh->do("drop table $drop") | |
25 | or die "Could not drop old table: ", $dbh->errstr; | |
26 | } | |
27 | ||
918735d1 | 28 | system "mysql -u$un -p$pw $db <$dist" |
abf5bbc6 TC |
29 | and die "Error loading database"; |
30 | ||
31 | $tl = $dbh->prepare("show tables") | |
32 | or die "prepare show tables ",$dbh->errstr; | |
33 | $tl->execute | |
34 | or die "execute show tables ",$tl->errstr; | |
b19047a6 TC |
35 | my @tables; |
36 | while (my $row = $tl->fetchrow_arrayref) { | |
37 | push(@tables, $row->[0]); | |
38 | } | |
39 | undef $tl; | |
2f003a93 | 40 | |
b19047a6 | 41 | my @expected = qw(field type null key default extra); |
85802bd5 | 42 | my @want = qw(field type null default extra); |
b19047a6 TC |
43 | for my $table (@tables) { |
44 | print "Table $table\n"; | |
45 | my $ti = $dbh->prepare("describe $table") | |
46 | or die "prepare describe $table: ",$dbh->errstr; | |
47 | $ti->execute() | |
48 | or die "execute describe $table: ",$dbh->errstr; | |
49 | my @names = @{$ti->{NAME_lc}}; | |
50 | my %names; | |
51 | @names{@names} = 0..$#names; | |
52 | for my $name (@expected) { | |
53 | exists $names{$name} | |
54 | or die "Didn't find expected field $name in describe table $table"; | |
55 | } | |
56 | while (my $row = $ti->fetchrow_arrayref) { | |
57 | for my $name (@want) { | |
58 | defined $row->[$names{$name}] or $row->[$names{$name}] = "NULL"; | |
85802bd5 TC |
59 | if ($name eq 'type' && |
60 | $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) { | |
61 | $row->[$names{$name}] = "varbinary($1)"; | |
62 | } | |
b19047a6 | 63 | } |
dc872a32 | 64 | print "Column ",join(";",@$row[@names{@want}]), |
b19047a6 TC |
65 | "\n"; |
66 | } | |
67 | undef $ti; | |
68 | my $ii = $dbh->prepare("show index from $table") | |
69 | or die "prepare show index from $table: ",$dbh->errstr; | |
70 | $ii->execute() | |
71 | or die "execute show index from $table: ",$dbh->errstr; | |
72 | my %indices; | |
73 | my %unique; | |
74 | while (my $row = $ii->fetchrow_hashref("NAME_lc")) { | |
75 | push(@{$indices{$row->{key_name}}}, | |
76 | [ $row->{column_name}, $row->{seq_in_index} ]); | |
77 | $unique{$row->{key_name}} = 0 + !$row->{non_unique}; | |
78 | } | |
79 | #use Data::Dumper; | |
80 | #print Dumper(\%indices); | |
81 | for my $index (sort keys %indices) { | |
82 | my @sorted = sort { $a->[1] <=> $b->[1] } @{$indices{$index}}; | |
dc872a32 TC |
83 | print "Index $index;$unique{$index};[", |
84 | join(";", map $_->[0], @sorted), | |
b19047a6 TC |
85 | "]\n"; |
86 | } | |
87 | } | |
88 | ||
89 | $dbh->disconnect; |