File Coverage

blib/lib/DBIx/DBSchema/Index.pm
Criterion Covered Total %
statement 6 40 15.0
branch 0 20 0.0
condition 0 6 0.0
subroutine 2 11 18.1
pod 9 9 100.0
total 17 86 19.7


line stmt bran cond sub pod time code
1             package DBIx::DBSchema::Index;
2              
3 1     1   6 use strict;
  1         2  
  1         39  
4 1     1   5 use vars qw($VERSION $DEBUG);
  1         2  
  1         639  
5              
6             $VERSION = 0.1;
7             $DEBUG = 0;
8              
9             =head1 NAME
10              
11             DBIx::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              
24             DBIx::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              
32             Creates a new DBIx::DBschema::Index object.
33              
34             Accepts either a hashref or a list of options and values.
35              
36             Options 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              
52             sub new {
53 0     0 1   my $proto = shift;
54 0   0       my $class = ref($proto) || $proto;
55 0 0         my %opt = ref($_[0]) ? %{$_[0]} : @_; #want a new reference
  0            
56 0           my $self = \%opt;
57 0           bless($self, $class);
58             }
59              
60             =item name [ INDEX_NAME ]
61              
62             Returns or sets the index name.
63              
64             =cut
65              
66             sub name {
67 0     0 1   my($self, $value) = @_;
68 0 0         if ( defined($value) ) {
69 0           $self->{name} = $value;
70             } else {
71 0           $self->{name};
72             }
73             }
74              
75             =item using [ INDEX_METHOD ]
76              
77             Returns or sets the optional index method.
78              
79             =cut
80              
81             sub using {
82 0     0 1   my($self, $value) = @_;
83 0 0         if ( defined($value) ) {
84 0           $self->{using} = $value;
85             } else {
86 0 0         defined($self->{using})
87             ? $self->{using}
88             : '';
89             }
90             }
91              
92             =item unique [ BOOL ]
93              
94             Returns or sets the unique flag.
95              
96             =cut
97              
98             sub unique {
99 0     0 1   my($self, $value) = @_;
100 0 0         if ( defined($value) ) {
101 0           $self->{unique} = $value;
102             } else {
103             #$self->{unique};
104 0 0         $self->{unique} ? 1 : 0;
105             }
106             }
107              
108             =item columns [ LISTREF ]
109              
110             Returns or sets the indexed columns (or expressions).
111              
112             =cut
113              
114             sub columns {
115 0     0 1   my($self, $value) = @_;
116 0 0         if ( defined($value) ) {
117 0           $self->{columns} = $value;
118             } else {
119 0           $self->{columns};
120             }
121             }
122              
123             =item columns_sql
124              
125             Returns a comma-joined list of columns, suitable for an SQL statement.
126              
127             =cut
128              
129             sub columns_sql {
130 0     0 1   my $self = shift;
131 0           join(', ', @{ $self->columns } );
  0            
132             }
133              
134             =item sql_create_index TABLENAME
135              
136             Returns an SQL statment to create this index on the specified table.
137              
138             =cut
139              
140             sub sql_create_index {
141 0     0 1   my( $self, $table ) = @_;
142              
143 0 0         my $unique = $self->unique ? 'UNIQUE' : '';
144 0           my $name = $self->name;
145 0           my $col_sql = $self->columns_sql;
146              
147 0           "CREATE $unique INDEX $name ON $table ( $col_sql )";
148             }
149              
150             =item cmp OTHER_INDEX_OBJECT
151              
152             Compares this object to another supplied object. Returns true if they are
153             identical, or false otherwise.
154              
155             =cut
156              
157             sub cmp {
158 0     0 1   my( $self, $other ) = @_;
159              
160 0 0         $self->name eq $other->name and $self->cmp_noname($other);
161             }
162              
163             =item cmp_noname OTHER_INDEX_OBJECT
164              
165             Compares this object to another supplied object. Returns true if they are
166             identical, disregarding index name, or false otherwise.
167              
168             =cut
169              
170             sub cmp_noname {
171 0     0 1   my( $self, $other ) = @_;
172              
173 0 0 0       $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              
183             Ivan Kohler
184              
185             Copyright (c) 2007 Ivan Kohler
186             Copyright (c) 2007 Freeside Internet Services, Inc.
187             All rights reserved.
188             This program is free software; you can redistribute it and/or modify it under
189             the same terms as Perl itself.
190              
191             =head1 BUGS
192              
193             Is there any situation in which sql_create_index needs to return a list of
194             multiple statements?
195              
196             =head1 SEE ALSO
197              
198             L, L, L
199              
200             =cut
201              
202             1;
203              
204