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