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