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;