fix for strange interpretation of 1liner

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Index.pm

diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm
index 3ee0e4c..2112bcd 100644 (file)
--- a/lib/SQL/Translator/Schema/Index.pm
+++ b/lib/SQL/Translator/Schema/Index.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Schema::Index;
 
 # ----------------------------------------------------------------------
-# $Id: Index.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $
+# $Id: Index.pm,v 1.7 2003-06-27 16:47:40 kycl4rk Exp $
 # ----------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
 #
@@ -39,7 +39,7 @@ SQL::Translator::Schema::Index - SQL::Translator index object
 
 C<SQL::Translator::Schema::Index> is the index object.
 
-Primary keys will be considered table constraints, not indices.
+Primary and unique keys are table constraints, not indices.
 
 =head1 METHODS
 
@@ -47,17 +47,19 @@ Primary keys will be considered table constraints, not indices.
 
 use strict;
 use Class::Base;
+use SQL::Translator::Schema::Constants;
+use SQL::Translator::Utils 'parse_list_arg';
 
 use base 'Class::Base';
 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
 
-$VERSION = 1.00;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
 
-use constant VALID_TYPE => {
-    unique      => 1,
-    normal      => 1,
-    full_text   => 1, # MySQL only (?)
-};
+my %VALID_INDEX_TYPE = (
+    UNIQUE,    1,
+    NORMAL,    1,
+    FULL_TEXT, 1, # MySQL only (?)
+);
 
 # ----------------------------------------------------------------------
 sub init {
@@ -73,10 +75,12 @@ Object constructor.
 =cut
 
     my ( $self, $config ) = @_;
-    for my $arg ( qw[ name type fields ] ) {
+
+    for my $arg ( qw[ name type fields table ] ) {
         next unless $config->{ $arg };
-        $self->$arg( $config->{ $arg } ) or return;
+        defined $self->$arg( $config->{ $arg } ) or return;
     }
+
     return $self;
 }
 
@@ -87,24 +91,64 @@ sub fields {
 
 =head2 fields
 
-Gets and set the fields the index is on.  Accepts a list or arrayref, 
-return both, too.
+Gets and set the fields the index is on.  Accepts a string, list or
+arrayref; returns an array or array reference.  Will unique the field
+names and keep them in order by the first occurrence of a field name.
 
-  my @fields = $index->fields( 'id' );
+  $index->fields('id');
+  $index->fields('id', 'name');
+  $index->fields( 'id, name' );
+  $index->fields( [ 'id', 'name' ] );
+  $index->fields( qw[ id name ] );
+
+  my @fields = $index->fields;
 
 =cut
 
     my $self   = shift;
-    my $fields = ref $_[0] eq 'ARRAY' ? shift : [ @_ ];
+    my $fields = parse_list_arg( @_ );
 
     if ( @$fields ) {
-        $self->{'fields'} = $fields;
+        my ( %unique, @unique );
+        for my $f ( @$fields ) {
+            next if $unique{ $f };
+            $unique{ $f } = 1;
+            push @unique, $f;
+        }
+
+        $self->{'fields'} = \@unique;
     }
 
     return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
 }
 
 # ----------------------------------------------------------------------
+sub is_valid {
+
+=pod
+
+=head2 is_valid
+
+Determine whether the index is valid or not.
+
+  my $ok = $index->is_valid;
+
+=cut
+
+    my $self   = shift;
+    my $table  = $self->table  or return $self->error('No table');
+    my @fields = $self->fields or return $self->error('No fields');
+
+    for my $field ( @fields ) {
+        return $self->error(
+            "Field '$field' does not exist in table '", $table->name, "'"
+        ) unless $table->get_field( $field );
+    }
+
+    return 1;
+}
+
+# ----------------------------------------------------------------------
 sub name {
 
 =pod
@@ -123,6 +167,56 @@ Get or set the index's name.
 }
 
 # ----------------------------------------------------------------------
+sub options {
+
+=pod
+
+=head2 options
+
+Get or set the index's options (e.g., "using" or "where" for PG).  Returns
+an array or array reference.
+
+  my @options = $index->options;
+
+=cut
+
+    my $self    = shift;
+    my $options = parse_list_arg( @_ );
+
+    push @{ $self->{'options'} }, @$options;
+
+    if ( ref $self->{'options'} ) {
+        return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
+    }
+    else {
+        return wantarray ? () : [];
+    }
+}
+
+# ----------------------------------------------------------------------
+sub table {
+
+=pod
+
+=head2 table
+
+Get or set the index's table object.
+
+  my $table = $index->table;
+
+=cut
+
+    my $self = shift;
+    if ( my $arg = shift ) {
+        return $self->error('Not a table object') unless
+            UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
+        $self->{'table'} = $arg;
+    }
+
+    return $self->{'table'};
+}
+
+# ----------------------------------------------------------------------
 sub type {
 
 =pod
@@ -139,29 +233,18 @@ Get or set the index's type.
 
     if ( my $type = shift ) {
         return $self->error("Invalid index type: $type") 
-            unless VALID_TYPE->{ $type };
+            unless $VALID_INDEX_TYPE{ $type };
         $self->{'type'} = $type;
     }
 
-    return $self->{'type'} || '';
+    return $self->{'type'} || NORMAL;
 }
 
 
 # ----------------------------------------------------------------------
-sub is_valid {
-
-=pod
-
-=head2 is_valid
-
-Determine whether the index is valid or not.
-
-  my $ok = $index->is_valid;
-
-=cut
-
+sub DESTROY {
     my $self = shift;
-    return ( $self->name && $self->{'type'} && @{ $self->fields } ) ? 1 : 0;
+    undef $self->{'table'}; # destroy cyclical reference
 }
 
 1;