File Coverage

blib/lib/DBICx/Indexing.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	13	14	92.8
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	62	63	98.4

package DBICx::Indexing;
our $VERSION = '0.002';

use strict;
use warnings;
use base qw/DBIx::Class/;

__PACKAGE__->mk_classdata('_dbicx_indexing');

sub indices {
  my $class = shift;

  if (@_) {
    my $idxs;
    if   (scalar(@_) == 1) { $idxs = $_[0] }
    else                   { $idxs = {@_} }

    for my $cols (values %$idxs) {
      $cols = [$cols] unless ref $cols eq 'ARRAY';
    }

    $class->_dbicx_indexing($idxs);
  }

  return $class->_dbicx_indexing;
}

sub sqlt_deploy_hook {
  my $self = shift;
  my ($table) = @_;

  $self->next::method(@_) if $self->next::can;

  my $indexes = $self->_dbicx_indexing;
  for my $name (keys %$indexes) {
    my $cols = $indexes->{$name};

    next if _has_cover_index($table, $cols);

    $table->add_index(name => $name, fields => $cols);
  }
}

sub _has_cover_index {
  my ($table, $cols) = @_;

  my @idxs;
  push @idxs, map { [$_->fields] } $table->get_indices;
  push @idxs, map { [$_->field_names] } $table->unique_constraints;
  push @idxs, [$table->primary_key->field_names];

IDXS: for my $flst (@idxs) {
    for my $c (@$cols) {
      next IDXS unless @$flst;
      next IDXS unless $flst->[0] eq $c;

      shift @$flst;
    }

    return 1;
  }

  return 0;
}

1;

__END__