DBSchema/ForeignKey.pm

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