missing test from git
[DBIx-DBSchema.git] / DBSchema / ForeignKey.pm
1 package DBIx::DBSchema::ForeignKey;
2
3 use strict;
4
5 our $VERSION = '0.13';
6 our $DEBUG = 0;
7
8 =head1 NAME
9
10 DBIx::DBSchema::ForeignKey - Foreign key objects
11
12 =head1 SYNOPSIS
13
14   use DBIx::DBSchema::ForeignKey;
15
16   $foreign_key = new DBIx::DBSchema::ForeignKey (
17     { 'columns' => [ 'column_name' ],
18       'table'   => 'foreign_table',
19     }
20   );
21
22   $foreign_key = new DBIx::DBSchema::ForeignKey (
23     {
24       'constraint' => 'constraint_name',
25       'columns'    => [ 'column_name', 'column2' ],
26       'table'      => 'foreign_table',
27       'references' => [ 'foreign_column', 'foreign_column2' ],
28       'match'      => 'MATCH FULL', # or MATCH SIMPLE
29       'on_delete'  => 'NO ACTION', # on clauses: NO ACTION / RESTRICT /
30       'on_update'  => 'RESTRICT',  #           CASCADE / SET NULL / SET DEFAULT
31     }
32   );
33
34 =head1 DESCRIPTION
35
36 DBIx::DBSchema::ForeignKey objects represent a foreign key.
37
38 =head1 METHODS
39
40 =over 4
41
42 =item new HASHREF | OPTION, VALUE, ...
43
44 Creates a new DBIx::DBschema::ForeignKey object.
45
46 Accepts either a hashref or a list of options and values.
47
48 Options are:
49
50 =over 8
51
52 =item constraint - constraint name
53
54 =item columns - List reference of column names
55
56 =item table - Foreign table name
57
58 =item references - List reference of column names in foreign table
59
60 =item match - 
61
62 =item on_delete - 
63
64 =item on_update - 
65
66 =back
67
68 =cut
69
70 sub new {
71   my $proto = shift;
72   my $class = ref($proto) || $proto;
73   my %opt = ref($_[0]) ? %{$_[0]} : @_; #want a new reference
74   my $self = \%opt;
75   bless($self, $class);
76 }
77
78 =item constraint [ CONSTRAINT_NAME ]
79
80 Returns or sets the constraint name
81
82 =cut
83
84 sub constraint {
85   my($self, $value) = @_;
86   if ( defined($value) ) {
87     $self->{constraint} = $value;
88   } else {
89     $self->{constraint};
90   }
91 }
92
93 =item table [ TABLE_NAME ]
94
95 Returns or sets the foreign table name
96
97 =cut
98
99 sub table {
100   my($self, $value) = @_;
101   if ( defined($value) ) {
102     $self->{table} = $value;
103   } else {
104     $self->{table};
105   }
106 }
107
108 =item columns [ LISTREF ]
109
110 Returns or sets the columns.
111
112 =cut
113
114 sub 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
125 Returns a comma-joined list of columns, suitable for an SQL statement.
126
127 =cut
128
129 sub columns_sql {
130   my $self = shift;
131   join(', ', @{ $self->columns } );
132 }
133
134 =item references [ LISTREF ]
135
136 Returns or sets the referenced columns.
137
138 =cut
139
140 sub references {
141   my($self, $value) = @_;
142   if ( defined($value) ) {
143     $self->{references} = $value;
144   } else {
145     $self->{references};
146   }
147 }
148
149 =item references_sql
150
151 Returns a comma-joined list of referenced columns, suitable for an SQL
152 statement.
153
154 =cut
155
156 sub references_sql {
157   my $self = shift;
158   join(', ', @{ $self->references || $self->columns } );
159 }
160
161 =item match [ TABLE_NAME ]
162
163 Returns or sets the MATCH clause
164
165 =cut
166
167 sub match {
168   my($self, $value) = @_;
169   if ( defined($value) ) {
170     $self->{match} = $value;
171   } else {
172     defined($self->{match}) ? $self->{match} : '';
173   }
174 }
175
176 =item on_delete [ ACTION ]
177
178 Returns or sets the ON DELETE clause
179
180 =cut
181
182 sub on_delete {
183   my($self, $value) = @_;
184   if ( defined($value) ) {
185     $self->{on_delete} = $value;
186   } else {
187     defined($self->{on_delete}) ? $self->{on_delete} : '';
188   }
189 }
190
191 =item on_update [ ACTION ]
192
193 Returns or sets the ON UPDATE clause
194
195 =cut
196
197 sub on_update {
198   my($self, $value) = @_;
199   if ( defined($value) ) {
200     $self->{on_update} = $value;
201   } else {
202     defined($self->{on_update}) ? $self->{on_update} : '';
203   }
204 }
205
206 =item sql_foreign_key
207
208 Returns an SQL FOREIGN KEY statement.
209
210 =cut
211
212 sub sql_foreign_key {
213   my( $self ) = @_;
214
215   my $table = $self->table;
216   my $col_sql = $self->columns_sql;
217   my $ref_sql = $self->references_sql;
218
219   "FOREIGN KEY ( $col_sql ) REFERENCES $table ( $ref_sql ) ".
220     join ' ', map { (my $thing_sql = uc($_) ) =~ s/_/ /g;
221                     "$thing_sql ". $self->$_;
222                   }
223                 grep $self->$_, qw( match on_delete on_update );
224 }
225
226 =item cmp OTHER_INDEX_OBJECT
227
228 Compares this object to another supplied object.  Returns true if they are
229 have the same table, columns and references.
230
231 =cut
232
233 sub cmp {
234   my( $self, $other ) = @_;
235
236   $self->table eq $other->table
237     and $self->columns_sql    eq $other->columns_sql
238     and $self->references_sql eq $other->references_sql
239     and uc($self->match)      eq uc($other->match)
240     and uc($self->on_delete)  eq uc($other->on_delete)
241     and uc($self->on_update)  eq uc($other->on_update)
242   ;
243 }
244
245 =back
246
247 =head1 AUTHOR
248
249 Ivan Kohler <ivan-dbix-dbschema@420.am>
250
251 Copyright (c) 2013 Freeside Internet Services, Inc.
252 All rights reserved.
253 This program is free software; you can redistribute it and/or modify it under
254 the same terms as Perl itself.
255
256 =head1 BUGS
257
258 Should give in and Mo or Moo.
259
260 =head1 SEE ALSO
261
262 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBI>
263
264 =cut
265
266 1;
267
268