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