lib/SQL/Translator/Schema/Index.pm

   1 package SQL::Translator::Schema::Index;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id$
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002-2009 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =pod
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Schema::Index - SQL::Translator index object
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator::Schema::Index;
  32   my $index = SQL::Translator::Schema::Index->new(
  33       name   => 'foo',
  34       fields => [ id ],
  35       type   => 'unique',
  36   );
  37
  38 =head1 DESCRIPTION
  39
  40 C<SQL::Translator::Schema::Index> is the index object.
  41
  42 Primary and unique keys are table constraints, not indices.
  43
  44 =head1 METHODS
  45
  46 =cut
  47
  48 use strict;
  49 use SQL::Translator::Schema::Constants;
  50 use SQL::Translator::Utils 'parse_list_arg';
  51
  52 use base 'SQL::Translator::Schema::Object';
  53
  54 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  55
  56 $VERSION = '1.99';
  57
  58 my %VALID_INDEX_TYPE = (
  59   UNIQUE         => 1,
  60   NORMAL         => 1,
  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 = shift;
 234
 235     if ( my $type = uc shift ) {
 236         return $self->error("Invalid index type: $type")
 237             unless $VALID_INDEX_TYPE{ $type };
 238         $self->{'type'} = $type;
 239     }
 240
 241     return $self->{'type'} || 'NORMAL';
 242 }
 243
 244 # ----------------------------------------------------------------------
 245 sub equals {
 246
 247 =pod
 248
 249 =head2 equals
 250
 251 Determines if this index is the same as another
 252
 253   my $isIdentical = $index1->equals( $index2 );
 254
 255 =cut
 256
 257     my $self = shift;
 258     my $other = shift;
 259     my $case_insensitive = shift;
 260     my $ignore_index_names = shift;
 261
 262     return 0 unless $self->SUPER::equals($other);
 263
 264     unless ($ignore_index_names) {
 265       unless ((!$self->name && ($other->name eq $other->fields->[0])) ||
 266         (!$other->name && ($self->name eq $self->fields->[0]))) {
 267         return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 268       }
 269     }
 270     #return 0 unless $self->is_valid eq $other->is_valid;
 271     return 0 unless $self->type eq $other->type;
 272
 273     # Check fields, regardless of order
 274     my %otherFields = ();       # create a hash of the other fields
 275     foreach my $otherField ($other->fields) {
 276         $otherField = uc($otherField) if $case_insensitive;
 277         $otherFields{$otherField} = 1;
 278     }
 279     foreach my $selfField ($self->fields) { # check for self fields in hash
 280         $selfField = uc($selfField) if $case_insensitive;
 281         return 0 unless $otherFields{$selfField};
 282         delete $otherFields{$selfField};
 283     }
 284     # Check all other fields were accounted for
 285     return 0 unless keys %otherFields == 0;
 286
 287     return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
 288     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 289     return 1;
 290 }
 291
 292 # ----------------------------------------------------------------------
 293 sub DESTROY {
 294     my $self = shift;
 295     undef $self->{'table'}; # destroy cyclical reference
 296 }
 297
 298 1;
 299
 300 # ----------------------------------------------------------------------
 301
 302 =pod
 303
 304 =head1 AUTHOR
 305
 306 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 307
 308 =cut