1package DBIx::DBSchema::Index;
2
3use strict;
4use vars qw($VERSION $DEBUG);
5
6$VERSION = 0.1;
7$DEBUG = 0;
8
9=head1 NAME
10
11DBIx::DBSchema::Index - Index objects
12
13=head1 SYNOPSYS
14
15  use DBIx::DBSchema::Index;
16
17  $index = new DBIx::DBSchema::Index (
18    {
19    }
20  );
21
22=head1 DESCRIPTION
23
24DBIx::DBSchema::Index objects represent a unique or non-unique database index.
25
26=head1 METHODS
27
28=over 4
29
30=item new HASHREF | OPTION, VALUE, ...
31
32Creates a new DBIx::DBschema::Index object.
33
34Accepts either a hashref or a list of options and values.
35
36Options are:
37
38=over 8
39
40=item name - Index name
41
42=item using - Optional index method
43
44=item unique - Boolean indicating whether or not this is a unique index.
45
46=item columns - List reference of column names (or expressions)
47
48=back
49
50=cut
51
52sub new {
53  my $proto = shift;
54  my $class = ref($proto) || $proto;
55  my %opt = ref($_[0]) ? %{$_[0]} : @_; #want a new reference
56  my $self = \%opt;
57  bless($self, $class);
58}
59
60=item name [ INDEX_NAME ]
61
62Returns or sets the index name.
63
64=cut
65
66sub name {
67  my($self, $value) = @_;
68  if ( defined($value) ) {
69    $self->{name} = $value;
70  } else {
71    $self->{name};
72  }
73}
74
75=item using [ INDEX_METHOD ]
76
77Returns or sets the optional index method.
78
79=cut
80
81sub using {
82  my($self, $value) = @_;
83  if ( defined($value) ) {
84    $self->{using} = $value;
85  } else {
86    defined($self->{using})
87      ? $self->{using}
88      : '';
89  }
90}
91
92=item unique [ BOOL ]
93
94Returns or sets the unique flag.
95
96=cut
97
98sub unique {
99  my($self, $value) = @_;
100  if ( defined($value) ) {
101    $self->{unique} = $value;
102  } else {
103    #$self->{unique};
104    $self->{unique} ? 1 : 0;
105  }
106}
107
108=item columns [ LISTREF ]
109
110Returns or sets the indexed columns (or expressions).
111
112=cut
113
114sub columns {
115  my($self, $value) = @_;
116  if ( defined($value) ) {
117    $self->{columns} = $value;
118  } else {
119    $self->{columns};
120  }
121}
122
123=item columns_sql
124
125Returns a comma-joined list of columns, suitable for an SQL statement.
126
127=cut
128
129sub columns_sql {
130  my $self = shift;
131  join(', ', @{ $self->columns } );
132}
133
134=item sql_create_index TABLENAME
135
136Returns an SQL statment to create this index on the specified table.
137
138=cut
139
140sub sql_create_index {
141  my( $self, $table ) = @_;
142
143  my $unique = $self->unique ? 'UNIQUE' : '';
144  my $name = $self->name;
145  my $col_sql = $self->columns_sql;
146
147  "CREATE $unique INDEX $name ON $table ( $col_sql )";
148}
149
150=item cmp OTHER_INDEX_OBJECT
151
152Compares this object to another supplied object.  Returns true if they are
153identical, or false otherwise.
154
155=cut
156
157sub cmp {
158  my( $self, $other ) = @_;
159
160  $self->name eq $other->name and $self->cmp_noname($other);
161}
162
163=item cmp_noname OTHER_INDEX_OBJECT
164
165Compares this object to another supplied object.  Returns true if they are
166identical, disregarding index name, or false otherwise.
167
168=cut
169
170sub cmp_noname {
171  my( $self, $other ) = @_;
172
173      $self->using       eq $other->using
174  and $self->unique      == $other->unique
175  and $self->columns_sql eq $other->columns_sql;
176
177}
178
179=back
180
181=head1 AUTHOR
182
183Ivan Kohler <ivan-dbix-dbschema@420.am>
184
185Copyright (c) 2007 Ivan Kohler
186Copyright (c) 2007 Freeside Internet Services, Inc.
187All rights reserved.
188This program is free software; you can redistribute it and/or modify it under
189the same terms as Perl itself.
190
191=head1 BUGS
192
193Is there any situation in which sql_create_index needs to return a list of
194multiple statements?
195
196=head1 SEE ALSO
197
198L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBI>
199
200=cut
201
2021;
203
204
205