DBSchema/DBD/mysql.pm

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