install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema/DBD/mysql.pm

   1 package DBIx::DBSchema::DBD::mysql;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA %typemap);
   5 use DBIx::DBSchema::DBD;
   6
   7 $VERSION = '0.03';
   8 @ISA = qw(DBIx::DBSchema::DBD);
   9
  10 %typemap = (
  11   'TIMESTAMP'      => 'DATETIME',
  12   'SERIAL'         => 'INTEGER',
  13   'BOOL'           => 'TINYINT',
  14   'LONG VARBINARY' => 'LONGBLOB',
  15 );
  16
  17 =head1 NAME
  18
  19 DBIx::DBSchema::DBD::mysql - MySQL native driver for DBIx::DBSchema
  20
  21 =head1 SYNOPSIS
  22
  23 use DBI;
  24 use DBIx::DBSchema;
  25
  26 $dbh = DBI->connect('dbi:mysql:database', 'user', 'pass');
  27 $schema = new_native DBIx::DBSchema $dbh;
  28
  29 =head1 DESCRIPTION
  30
  31 This module implements a MySQL-native driver for DBIx::DBSchema.
  32
  33 =cut
  34
  35 sub columns {
  36   my($proto, $dbh, $table ) = @_;
  37   my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr;
  38   $sth->execute or die $sth->errstr;
  39   map {
  40     $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
  41       or die "Illegal type: ". $_->{'Type'}. "\n";
  42     my($type, $length) = ($1, $2);
  43     [
  44       $_->{'Field'},
  45       $type,
  46       $_->{'Null'},
  47       $length,
  48       $_->{'Default'},
  49       $_->{'Extra'}
  50     ]
  51   } @{ $sth->fetchall_arrayref( {} ) };
  52 }
  53
  54 #sub primary_key {
  55 #  my($proto, $dbh, $table ) = @_;
  56 #  my $primary_key = '';
  57 #  my $sth = $dbh->prepare("SHOW INDEX FROM $table")
  58 #    or die $dbh->errstr;
  59 #  $sth->execute or die $sth->errstr;
  60 #  my @pkey = map { $_->{'Column_name'} } grep {
  61 #    $_->{'Key_name'} eq "PRIMARY"
  62 #  } @{ $sth->fetchall_arrayref( {} ) };
  63 #  scalar(@pkey) ? $pkey[0] : '';
  64 #}
  65
  66 sub primary_key {
  67   my($proto, $dbh, $table) = @_;
  68   my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
  69   $pkey;
  70 }
  71
  72 sub unique {
  73   my($proto, $dbh, $table) = @_;
  74   my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
  75   $unique_href;
  76 }
  77
  78 sub index {
  79   my($proto, $dbh, $table) = @_;
  80   my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
  81   $index_href;
  82 }
  83
  84 sub _show_index {
  85   my($proto, $dbh, $table ) = @_;
  86   my $sth = $dbh->prepare("SHOW INDEX FROM $table")
  87     or die $dbh->errstr;
  88   $sth->execute or die $sth->errstr;
  89
  90   my $pkey = '';
  91   my(%index, %unique);
  92   foreach my $row ( @{ $sth->fetchall_arrayref({}) } ) {
  93     if ( $row->{'Key_name'} eq 'PRIMARY' ) {
  94       $pkey = $row->{'Column_name'};
  95     } elsif ( $row->{'Non_unique'} ) { #index
  96       push @{ $index{ $row->{'Key_name'} } }, $row->{'Column_name'};
  97     } else { #unique
  98       push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'};
  99     }
 100   }
 101
 102   ( $pkey, \%unique, \%index );
 103 }
 104
 105 =head1 AUTHOR
 106
 107 Ivan Kohler <ivan-dbix-dbschema@420.am>
 108
 109 =head1 COPYRIGHT
 110
 111 Copyright (c) 2000 Ivan Kohler
 112 Copyright (c) 2000 Mail Abuse Prevention System LLC
 113 All rights reserved.
 114 This program is free software; you can redistribute it and/or modify it under
 115 the same terms as Perl itself.
 116
 117 =head1 BUGS
 118
 119 =head1 SEE ALSO
 120
 121 L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>
 122
 123 =cut
 124
 125 1;
 126