| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Alzabo::Create::Column; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 9 |  |  | 9 |  | 51 | use strict; | 
|  | 9 |  |  |  |  | 18 |  | 
|  | 9 |  |  |  |  | 557 |  | 
| 4 | 9 |  |  | 9 |  | 47 | use vars qw($VERSION); | 
|  | 9 |  |  |  |  | 26 |  | 
|  | 9 |  |  |  |  | 384 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 9 |  |  | 9 |  | 51 | use Alzabo::Create; | 
|  | 9 |  |  |  |  | 18 |  | 
|  | 9 |  |  |  |  | 268 |  | 
| 7 | 9 |  |  | 9 |  | 55 | use Alzabo::Exceptions ( abbr => 'params_exception' ); | 
|  | 9 |  |  |  |  | 20 |  | 
|  | 9 |  |  |  |  | 136 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 9 |  |  | 9 |  | 52 | use Params::Validate qw( :all ); | 
|  | 9 |  |  |  |  | 16 |  | 
|  | 9 |  |  |  |  | 2758 |  | 
| 10 |  |  |  |  |  |  | Params::Validate::validation_options | 
| 11 |  |  |  |  |  |  | ( on_fail => sub { params_exception join '', @_ } ); | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 9 |  |  | 9 |  | 58 | use base qw(Alzabo::Column); | 
|  | 9 |  |  |  |  | 20 |  | 
|  | 9 |  |  |  |  | 17011 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | $VERSION = 2.0; | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | 1; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | sub new | 
| 20 |  |  |  |  |  |  | { | 
| 21 | 0 |  |  | 0 | 1 |  | my $proto = shift; | 
| 22 | 0 |  | 0 |  |  |  | my $class = ref $proto || $proto; | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 0 |  |  |  |  |  | my $self = bless {}, $class; | 
| 25 |  |  |  |  |  |  |  | 
| 26 | 0 |  |  |  |  |  | $self->_init(@_); | 
| 27 |  |  |  |  |  |  |  | 
| 28 | 0 |  |  |  |  |  | return $self; | 
| 29 |  |  |  |  |  |  | } | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | sub _init | 
| 32 |  |  |  |  |  |  | { | 
| 33 | 0 |  |  | 0 |  |  | my $self = shift; | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 0 |  |  |  |  |  | my %p = | 
| 36 |  |  |  |  |  |  | validate( @_, { table => { isa => 'Alzabo::Table' }, | 
| 37 |  |  |  |  |  |  | name  => { type => SCALAR }, | 
| 38 |  |  |  |  |  |  | null  => { optional => 1 }, | 
| 39 |  |  |  |  |  |  | nullable => { optional => 1 }, | 
| 40 |  |  |  |  |  |  | type  => { type => SCALAR, | 
| 41 |  |  |  |  |  |  | optional => 1 }, | 
| 42 |  |  |  |  |  |  | attributes => { type => ARRAYREF, | 
| 43 |  |  |  |  |  |  | default => [] }, | 
| 44 |  |  |  |  |  |  | default    => { type => BOOLEAN, | 
| 45 |  |  |  |  |  |  | optional => 1 }, | 
| 46 |  |  |  |  |  |  | default_is_raw => { type => BOOLEAN, | 
| 47 |  |  |  |  |  |  | default => 0 }, | 
| 48 |  |  |  |  |  |  | sequenced  => { optional => 1 }, | 
| 49 |  |  |  |  |  |  | length => { type => BOOLEAN, | 
| 50 |  |  |  |  |  |  | optional => 1 }, | 
| 51 |  |  |  |  |  |  | precision  => { type => BOOLEAN, | 
| 52 |  |  |  |  |  |  | optional => 1 }, | 
| 53 |  |  |  |  |  |  | definition => { isa => 'Alzabo::Create::ColumnDefinition', | 
| 54 |  |  |  |  |  |  | optional => 1 }, | 
| 55 |  |  |  |  |  |  | comment => { type => BOOLEAN, | 
| 56 |  |  |  |  |  |  | default => '' }, | 
| 57 |  |  |  |  |  |  | } ); | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 0 |  |  |  |  |  | $self->set_table( $p{table} ); | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 0 |  |  |  |  |  | $self->set_name( $p{name} ); | 
| 62 |  |  |  |  |  |  |  | 
| 63 | 0 |  | 0 |  |  |  | $self->{nullable} = $p{nullable} || $p{null} || 0; | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 0 | 0 |  |  |  |  | if ($p{definition}) | 
| 66 |  |  |  |  |  |  | { | 
| 67 | 0 |  |  |  |  |  | $self->set_definition( $p{definition} ); | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  | else | 
| 70 |  |  |  |  |  |  | { | 
| 71 | 0 |  |  |  |  |  | $self->set_definition | 
| 72 |  |  |  |  |  |  | ( Alzabo::Create::ColumnDefinition->new | 
| 73 |  |  |  |  |  |  | ( owner => $self, | 
| 74 |  |  |  |  |  |  | type => $p{type}, | 
| 75 |  |  |  |  |  |  | ) | 
| 76 |  |  |  |  |  |  | ); | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 | 0 |  |  |  |  |  | my %attr; | 
| 80 | 0 |  |  |  |  |  | tie %{ $self->{attributes} }, 'Tie::IxHash'; | 
|  | 0 |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  |  | 
| 82 | 0 |  |  |  |  |  | $self->set_attributes( @{ $p{attributes} } ); | 
|  | 0 |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 0 |  | 0 |  |  |  | $self->set_sequenced( $p{sequenced} || 0 ); | 
| 85 |  |  |  |  |  |  |  | 
| 86 | 0 | 0 |  |  |  |  | $self->set_default( $p{default} ) | 
| 87 |  |  |  |  |  |  | if exists $p{default}; | 
| 88 | 0 |  |  |  |  |  | $self->set_default_is_raw( $p{default_is_raw} ); | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | # We always set length, since not giving a length at all may be an | 
| 91 |  |  |  |  |  |  | # error for some column types, unless we got a definition object, | 
| 92 |  |  |  |  |  |  | # in which case it should contain the length & precision. | 
| 93 | 0 | 0 |  |  |  |  | $self->set_length( length => $p{length}, precision => $p{precision} ) | 
| 94 |  |  |  |  |  |  | unless $p{definition}; | 
| 95 |  |  |  |  |  |  |  | 
| 96 | 0 |  |  |  |  |  | $self->set_comment( $p{comment} ); | 
| 97 |  |  |  |  |  |  | } | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | sub set_table | 
| 100 |  |  |  |  |  |  | { | 
| 101 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 102 |  |  |  |  |  |  |  | 
| 103 | 0 |  |  |  |  |  | validate_pos( @_, { isa => 'Alzabo::Create::Table' } ); | 
| 104 | 0 |  |  |  |  |  | $self->{table} = shift; | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | sub set_name | 
| 108 |  |  |  |  |  |  | { | 
| 109 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 110 |  |  |  |  |  |  |  | 
| 111 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 112 | 0 |  |  |  |  |  | my $name = shift; | 
| 113 |  |  |  |  |  |  |  | 
| 114 | 0 | 0 |  |  |  |  | params_exception "Column $name already exists in table" | 
| 115 |  |  |  |  |  |  | if $self->table->has_column($name); | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 0 |  |  |  |  |  | my $old_name = $self->{name}; | 
| 118 | 0 |  |  |  |  |  | $self->{name} = $name; | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | eval | 
| 121 | 0 |  |  |  |  |  | { | 
| 122 | 0 |  |  |  |  |  | $self->table->schema->rules->validate_column_name($self); | 
| 123 |  |  |  |  |  |  | }; | 
| 124 | 0 | 0 |  |  |  |  | if ($@) | 
| 125 |  |  |  |  |  |  | { | 
| 126 | 0 |  |  |  |  |  | $self->{name} = $old_name; | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 0 |  |  |  |  |  | rethrow_exception($@); | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 | 0 | 0 |  |  |  |  | $self->table->register_column_name_change( column => $self, | 
| 132 |  |  |  |  |  |  | old_name => $old_name ) | 
| 133 |  |  |  |  |  |  | if $old_name; | 
| 134 |  |  |  |  |  |  | } | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | sub set_nullable | 
| 137 |  |  |  |  |  |  | { | 
| 138 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 139 |  |  |  |  |  |  |  | 
| 140 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 141 | 0 |  |  |  |  |  | my $n = shift; | 
| 142 |  |  |  |  |  |  |  | 
| 143 | 0 | 0 | 0 |  |  |  | params_exception "Invalid value for nullable attribute: $n" | 
| 144 |  |  |  |  |  |  | unless $n eq '1' || $n eq '0'; | 
| 145 |  |  |  |  |  |  |  | 
| 146 | 0 | 0 | 0 |  |  |  | params_exception "Primary key column cannot be nullable" | 
| 147 |  |  |  |  |  |  | if $n eq '1' && $self->is_primary_key; | 
| 148 |  |  |  |  |  |  |  | 
| 149 | 0 |  |  |  |  |  | $self->{nullable} = $n; | 
| 150 |  |  |  |  |  |  | } | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | sub set_default | 
| 153 |  |  |  |  |  |  | { | 
| 154 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 155 |  |  |  |  |  |  |  | 
| 156 | 0 |  |  |  |  |  | validate_pos( @_, { type => BOOLEAN } ); | 
| 157 | 0 |  |  |  |  |  | $self->{default} = shift; | 
| 158 |  |  |  |  |  |  | } | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | sub set_default_is_raw | 
| 161 |  |  |  |  |  |  | { | 
| 162 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 0 |  |  |  |  |  | validate_pos( @_, { type => BOOLEAN } ); | 
| 165 | 0 |  |  |  |  |  | $self->{default_is_raw} = shift; | 
| 166 |  |  |  |  |  |  | } | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | sub set_length | 
| 169 |  |  |  |  |  |  | { | 
| 170 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 0 |  |  |  |  |  | $self->{definition}->set_length(@_); | 
| 173 |  |  |  |  |  |  | } | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | sub set_attributes | 
| 176 |  |  |  |  |  |  | { | 
| 177 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 0 |  |  |  |  |  | validate_pos( @_, ( { type => SCALAR } ) x @_ ); | 
| 180 |  |  |  |  |  |  |  | 
| 181 | 0 |  |  |  |  |  | %{ $self->{attributes} } = (); | 
|  | 0 |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 0 |  |  |  |  |  | foreach (@_) | 
| 184 |  |  |  |  |  |  | { | 
| 185 | 0 |  |  |  |  |  | $self->add_attribute($_); | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  | } | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | sub add_attribute | 
| 190 |  |  |  |  |  |  | { | 
| 191 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 194 | 0 |  |  |  |  |  | my $attr = shift; | 
| 195 |  |  |  |  |  |  |  | 
| 196 | 0 |  |  |  |  |  | $attr =~ s/^\s+//; | 
| 197 | 0 |  |  |  |  |  | $attr =~ s/\s+$//; | 
| 198 |  |  |  |  |  |  |  | 
| 199 | 0 |  |  |  |  |  | $self->table->schema->rules->validate_column_attribute( column => $self, | 
| 200 |  |  |  |  |  |  | attribute => $attr ); | 
| 201 |  |  |  |  |  |  |  | 
| 202 | 0 |  |  |  |  |  | $self->{attributes}{$attr} = 1; | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | sub delete_attribute | 
| 206 |  |  |  |  |  |  | { | 
| 207 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 208 |  |  |  |  |  |  |  | 
| 209 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 210 | 0 |  |  |  |  |  | my $attr = shift; | 
| 211 |  |  |  |  |  |  |  | 
| 212 | 0 | 0 |  |  |  |  | params_exception "Column " . $self->name . " doesn't have attribute $attr" | 
| 213 |  |  |  |  |  |  | unless exists $self->{attributes}{$attr}; | 
| 214 |  |  |  |  |  |  |  | 
| 215 | 0 |  |  |  |  |  | delete $self->{attributes}{$attr}; | 
| 216 |  |  |  |  |  |  | } | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | sub alter | 
| 219 |  |  |  |  |  |  | { | 
| 220 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 221 | 0 |  |  |  |  |  | $self->{definition}->alter(@_); | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | # this will force them to go through the rules code again. | 
| 224 |  |  |  |  |  |  | # Attributes that don't work with the new type are silently | 
| 225 |  |  |  |  |  |  | # discarded. | 
| 226 | 0 |  |  |  |  |  | foreach ( $self->attributes ) | 
| 227 |  |  |  |  |  |  | { | 
| 228 | 0 |  |  |  |  |  | $self->delete_attribute($_); | 
| 229 | 0 |  |  |  |  |  | eval { $self->add_attribute($_) }; | 
|  | 0 |  |  |  |  |  |  | 
| 230 |  |  |  |  |  |  | } | 
| 231 |  |  |  |  |  |  | } | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | sub set_type | 
| 234 |  |  |  |  |  |  | { | 
| 235 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 236 |  |  |  |  |  |  |  | 
| 237 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 238 | 0 |  |  |  |  |  | my $t = shift; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 0 |  |  |  |  |  | $self->{definition}->set_type($t); | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | # this will force them to go through the rules code again. | 
| 243 |  |  |  |  |  |  | # Attributes that don't work with the new type are silently | 
| 244 |  |  |  |  |  |  | # discarded. | 
| 245 | 0 |  |  |  |  |  | foreach ( $self->attributes ) | 
| 246 |  |  |  |  |  |  | { | 
| 247 | 0 |  |  |  |  |  | $self->delete_attribute($_); | 
| 248 | 0 |  |  |  |  |  | eval { $self->add_attribute($_) }; | 
|  | 0 |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | } | 
| 250 |  |  |  |  |  |  |  | 
| 251 | 0 | 0 |  |  |  |  | if ( $self->length ) | 
| 252 |  |  |  |  |  |  | { | 
| 253 | 0 |  |  |  |  |  | eval { $self->set_length( length => $self->length, | 
|  | 0 |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | precision => $self->precision ) }; | 
| 255 | 0 | 0 |  |  |  |  | if ($@) | 
| 256 |  |  |  |  |  |  | { | 
| 257 | 0 |  |  |  |  |  | eval { $self->set_length( length => $self->length, precision => undef ) }; | 
|  | 0 |  |  |  |  |  |  | 
| 258 | 0 | 0 |  |  |  |  | if ($@) | 
| 259 |  |  |  |  |  |  | { | 
| 260 | 0 |  |  |  |  |  | $self->set_length( length => undef, | 
| 261 |  |  |  |  |  |  | precision => undef ); | 
| 262 |  |  |  |  |  |  | } | 
| 263 |  |  |  |  |  |  | } | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  | } | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | sub set_sequenced | 
| 268 |  |  |  |  |  |  | { | 
| 269 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 270 |  |  |  |  |  |  |  | 
| 271 | 0 |  |  |  |  |  | validate_pos( @_, { type => SCALAR } ); | 
| 272 | 0 |  |  |  |  |  | my $s = shift; | 
| 273 |  |  |  |  |  |  |  | 
| 274 | 0 | 0 | 0 |  |  |  | params_exception "Invalid value for sequenced attribute: $s" | 
| 275 |  |  |  |  |  |  | unless $s eq '1' || $s eq '0'; | 
| 276 |  |  |  |  |  |  |  | 
| 277 | 0 | 0 |  |  |  |  | $self->table->schema->rules->validate_sequenced_attribute($self) | 
| 278 |  |  |  |  |  |  | if $s eq '1'; | 
| 279 |  |  |  |  |  |  |  | 
| 280 | 0 |  |  |  |  |  | $self->{sequenced} = $s; | 
| 281 |  |  |  |  |  |  | } | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | sub set_definition | 
| 284 |  |  |  |  |  |  | { | 
| 285 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 286 |  |  |  |  |  |  |  | 
| 287 | 0 |  |  |  |  |  | validate_pos( @_, { isa => 'Alzabo::Create::ColumnDefinition' } ); | 
| 288 | 0 |  |  |  |  |  | my $d = shift; | 
| 289 |  |  |  |  |  |  |  | 
| 290 | 0 |  |  |  |  |  | $self->{definition} = $d; | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  |  | 
| 293 | 0 | 0 |  | 0 | 1 |  | sub set_comment { $_[0]->{comment} = defined $_[1] ? $_[1] : '' } | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | sub save_current_name | 
| 296 |  |  |  |  |  |  | { | 
| 297 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 298 |  |  |  |  |  |  |  | 
| 299 | 0 |  |  |  |  |  | $self->{last_instantiated_name} = $self->name; | 
| 300 |  |  |  |  |  |  | } | 
| 301 |  |  |  |  |  |  |  | 
| 302 | 0 |  |  | 0 | 1 |  | sub former_name { $_[0]->{last_instantiated_name} } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | __END__ |