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 = "/home/tony/dev/bse/base/bse/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 for my $drop (@drop_tables) {
  24   $dbh->do("drop table $drop")
  25     or die "Could not drop old table: ", $dbh->errstr;
  26 }
  27
  28 system "mysql -u$un -p$pw $db <$dist"
  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;
  35 my @tables;
  36 while (my $row = $tl->fetchrow_arrayref) {
  37   push(@tables, $row->[0]);
  38 }
  39 undef $tl;
  40
  41 my @expected = qw(field type null key default extra);
  42 my @want =     qw(field type null default extra);
  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";
  59       if ($name eq 'type' &&
  60           $row->[$names{$name}] =~ /^varchar\((\d+)\) binary$/i) {
  61         $row->[$names{$name}] = "varbinary($1)";
  62       }
  63     }
  64     print "Column ",join(";",@$row[@names{@want}]),
  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}};
  83     print "Index $index;$unique{$index};[",
  84       join(";", map $_->[0], @sorted),
  85       "]\n";
  86   }
  87 }
  88
  89 $dbh->disconnect;