view release on metacpan or  search on metacpan

lib/Apache/Voodoo/Table/Probe/MySQL.pm  view on Meta::CPAN

	return $self;
}

sub list_tables {
	my $self = shift;

	my $res = $self->{'dbh'}->selectall_arrayref("show tables") || die $DBI::errstr;

	return map { $_->[0] } @{$res};
}

sub probe_table {
	my $self = shift;

	my $table = shift;

	my $dbh = $self->{'dbh'};

	tie my %data, 'Tie::Hash::Indexed';

	$data{table} = $table;
	$data{primary_key} = '';

	tie my %columns, 'Tie::Hash::Indexed';
	$data{columns} = \%columns;

	# get foreign key infomation about the given table
	my $db_name = $dbh->{'Name'};
	$db_name =~ s/:.*//;
	my $sth = $dbh->foreign_key_info(undef,undef,undef,undef,$db_name,$table) || die DBI->errstr;
	my %foreign_keys;
	foreach (@{$sth->fetchall_arrayref()}) {
		next unless $_->[2];	# not a foreign key
		$foreign_keys{$_->[7]} = [ $_->[2], $_->[3] ];
	}

	# Sadly the column_info method doesn't tell us if the column is auto increment or not.
	# So we're going after the column info using ye olde explain.
	my $table_info = $dbh->selectall_arrayref("explain $table") || return { 'ERRORS' => [ "explain of table $table failed. $DBI::errstr" ] };
	foreach my $row (@{$table_info}) {
		my $name = $row->[0];

		tie my %column, 'Tie::Hash::Indexed';

		#
		# figure out the column type
		#
		my $type = $row->[1];
		my ($size) = ($type =~ /\(([\d,]+)\)/);

		$type =~ s/[,\d\(\) ]+/_/g;
		$type =~ s/_$//g;

		if ($self->can($type)) {
			$self->$type(\%column,$size);
		}
		else {
			push(@{$data{'ERRORS'}},"unsupported type $row->[1]");
		}

		# is this param required for add / edit (does the column allow nulls)
		$column{'required'} = 1 unless $row->[2] eq "YES";

		if ($row->[3] eq "PRI") {
			# primary key.  NOTE THAT CLUSTERED PRIMARY KEYS ARE NOT SUPPORTED
			$data{'primary_key'} = $name;

			# is the primary key user supplied
			unless ($row->[5] eq "auto_increment") {
				$data{'pkey_user_supplied'} = 1;
			}
		}
		elsif ($row->[3] eq "UNI") {
			# unique index.
			$column{'unique'} = 1;
		}

		#
		# figure out foreign keys
		#
		my $ref_table = '';
		my $ref_id    = '';
		if (scalar(%foreign_keys)) {
			# there are foreign keys defined for this table
			if (defined($foreign_keys{$name})) {
				# this column is a foreign key
				($ref_table,$ref_id) = @{$foreign_keys{$name}};
			}
		}
		elsif ($name =~ /^(\w+)_id$/) {
			# this column follows the standard naming convention
			# let's assume that it's supposed to be a foreign key.
			$ref_table = $1;
		}

		if ($ref_table) {
			my $ref_table_info = $dbh->selectall_arrayref("explain $ref_table");
			if (ref($ref_table_info)) {
				# figure out table structure

				my $ref_data = $self->probe_table($ref_table);

				tie my %ref_info, 'Tie::Hash::Indexed';
				%ref_info = (
					'table'          => $ref_table,
					'primary_key'    => $ref_id || $ref_data->{'primary_key'},
					'select_label'   => $ref_table,
					'select_default' => $row->[4],
					'columns'        => [
						grep { $ref_data->{'columns'}->{$_}->{'type'} eq "varchar" }
						keys %{$ref_data->{'columns'}}
					]
				);

				$column{'references'} = \%ref_info;
			}
			else {
				warn("No such table $ref_table: $DBI::errstr");
			}
		}