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