lib/SQL/Translator/Schema/Index.pm

   1 package SQL::Translator::Schema::Index;
   2
   3 # ----------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; version 2.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =pod
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Schema::Index - SQL::Translator index object
  26
  27 =head1 SYNOPSIS
  28
  29   use SQL::Translator::Schema::Index;
  30   my $index = SQL::Translator::Schema::Index->new(
  31       name   => 'foo',
  32       fields => [ id ],
  33       type   => 'unique',
  34   );
  35
  36 =head1 DESCRIPTION
  37
  38 C<SQL::Translator::Schema::Index> is the index object.
  39
  40 Primary and unique keys are table constraints, not indices.
  41
  42 =head1 METHODS
  43
  44 =cut
  45
  46 use strict;
  47 use SQL::Translator::Schema::Constants;
  48 use SQL::Translator::Utils 'parse_list_arg';
  49 use Readonly;
  50
  51 use base 'SQL::Translator::Schema::Object';
  52
  53 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  54
  55 $VERSION = '1.60';
  56
  57 Readonly my %VALID_INDEX_TYPE => (
  58     UNIQUE    => 1,
  59     NORMAL    => 1,
  60     FULLTEXT  => 1,    # MySQL only (?)
  61     FULL_TEXT => 1,    # MySQL only (?)
  62     SPATIAL   => 1,    # MySQL only (?)
  63 );
  64
  65 # ----------------------------------------------------------------------
  66
  67 __PACKAGE__->_attributes( qw/
  68     name type fields table options
  69 /);
  70
  71 =pod
  72
  73 =head2 new
  74
  75 Object constructor.
  76
  77   my $schema = SQL::Translator::Schema::Index->new;
  78
  79 =cut
  80
  81 # ----------------------------------------------------------------------
  82 sub fields {
  83
  84 =pod
  85
  86 =head2 fields
  87
  88 Gets and set the fields the index is on.  Accepts a string, list or
  89 arrayref; returns an array or array reference.  Will unique the field
  90 names and keep them in order by the first occurrence of a field name.
  91
  92   $index->fields('id');
  93   $index->fields('id', 'name');
  94   $index->fields( 'id, name' );
  95   $index->fields( [ 'id', 'name' ] );
  96   $index->fields( qw[ id name ] );
  97
  98   my @fields = $index->fields;
  99
 100 =cut
 101
 102     my $self   = shift;
 103     my $fields = parse_list_arg( @_ );
 104
 105     if ( @$fields ) {
 106         my ( %unique, @unique );
 107         for my $f ( @$fields ) {
 108             next if $unique{ $f };
 109             $unique{ $f } = 1;
 110             push @unique, $f;
 111         }
 112
 113         $self->{'fields'} = \@unique;
 114     }
 115
 116     return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
 117 }
 118
 119 # ----------------------------------------------------------------------
 120 sub is_valid {
 121
 122 =pod
 123
 124 =head2 is_valid
 125
 126 Determine whether the index is valid or not.
 127
 128   my $ok = $index->is_valid;
 129
 130 =cut
 131
 132     my $self   = shift;
 133     my $table  = $self->table  or return $self->error('No table');
 134     my @fields = $self->fields or return $self->error('No fields');
 135
 136     for my $field ( @fields ) {
 137         return $self->error(
 138             "Field '$field' does not exist in table '", $table->name, "'"
 139         ) unless $table->get_field( $field );
 140     }
 141
 142     return 1;
 143 }
 144
 145 # ----------------------------------------------------------------------
 146 sub name {
 147
 148 =pod
 149
 150 =head2 name
 151
 152 Get or set the index's name.
 153
 154   my $name = $index->name('foo');
 155
 156 =cut
 157
 158     my $self = shift;
 159     $self->{'name'} = shift if @_;
 160     return $self->{'name'} || '';
 161 }
 162
 163 # ----------------------------------------------------------------------
 164 sub options {
 165
 166 =pod
 167
 168 =head2 options
 169
 170 Get or set the index's options (e.g., "using" or "where" for PG).  Returns
 171 an array or array reference.
 172
 173   my @options = $index->options;
 174
 175 =cut
 176
 177     my $self    = shift;
 178     my $options = parse_list_arg( @_ );
 179
 180     push @{ $self->{'options'} }, @$options;
 181
 182     if ( ref $self->{'options'} ) {
 183         return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
 184     }
 185     else {
 186         return wantarray ? () : [];
 187     }
 188 }
 189
 190 # ----------------------------------------------------------------------
 191 sub table {
 192
 193 =pod
 194
 195 =head2 table
 196
 197 Get or set the index's table object.
 198
 199   my $table = $index->table;
 200
 201 =cut
 202
 203     my $self = shift;
 204     if ( my $arg = shift ) {
 205         return $self->error('Not a table object') unless
 206             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
 207         $self->{'table'} = $arg;
 208     }
 209
 210     return $self->{'table'};
 211 }
 212
 213 # ----------------------------------------------------------------------
 214 sub type {
 215
 216 =pod
 217
 218 =head2 type
 219
 220 Get or set the index's type.
 221
 222   my $type = $index->type('unique');
 223
 224 Get or set the index's options (e.g., "using" or "where" for PG).  Returns
 225
 226 Currently there are only four acceptable types: UNIQUE, NORMAL, FULL_TEXT,
 227 and SPATIAL. The latter two might be MySQL-specific. While both lowercase
 228 and uppercase types are acceptable input, this method returns the type in
 229 uppercase.
 230
 231 =cut
 232
 233     my ( $self, $type ) = @_;
 234
 235     if ( $type ) {
 236         $type = uc $type;
 237         return $self->error("Invalid index type: $type")
 238             unless $VALID_INDEX_TYPE{ $type };
 239         $self->{'type'} = $type;
 240     }
 241
 242     return $self->{'type'} || 'NORMAL';
 243 }
 244
 245 # ----------------------------------------------------------------------
 246 sub equals {
 247
 248 =pod
 249
 250 =head2 equals
 251
 252 Determines if this index is the same as another
 253
 254   my $isIdentical = $index1->equals( $index2 );
 255
 256 =cut
 257
 258     my $self = shift;
 259     my $other = shift;
 260     my $case_insensitive = shift;
 261     my $ignore_index_names = shift;
 262
 263     return 0 unless $self->SUPER::equals($other);
 264
 265     unless ($ignore_index_names) {
 266       unless ((!$self->name && ($other->name eq $other->fields->[0])) ||
 267         (!$other->name && ($self->name eq $self->fields->[0]))) {
 268         return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 269       }
 270     }
 271     #return 0 unless $self->is_valid eq $other->is_valid;
 272     return 0 unless $self->type eq $other->type;
 273
 274     # Check fields, regardless of order
 275     my %otherFields = ();       # create a hash of the other fields
 276     foreach my $otherField ($other->fields) {
 277         $otherField = uc($otherField) if $case_insensitive;
 278         $otherFields{$otherField} = 1;
 279     }
 280     foreach my $selfField ($self->fields) { # check for self fields in hash
 281         $selfField = uc($selfField) if $case_insensitive;
 282         return 0 unless $otherFields{$selfField};
 283         delete $otherFields{$selfField};
 284     }
 285     # Check all other fields were accounted for
 286     return 0 unless keys %otherFields == 0;
 287
 288     return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
 289     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 290     return 1;
 291 }
 292
 293 # ----------------------------------------------------------------------
 294 sub DESTROY {
 295     my $self = shift;
 296     undef $self->{'table'}; # destroy cyclical reference
 297 }
 298
 299 1;
 300
 301 # ----------------------------------------------------------------------
 302
 303 =pod
 304
 305 =head1 AUTHOR
 306
 307 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
 308
 309 =cut