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