1package Data::Model::Schema::Properties; 2use strict; 3use warnings; 4use base qw(Data::Model::Accessor); 5 6use Carp (); 7$Carp::Internal{(__PACKAGE__)}++; 8 9use Class::Trigger qw( pre_insert pre_save post_save post_load pre_update pre_inflate post_inflate pre_deflate post_deflate ); 10use Encode (); 11use Params::Validate ':all'; 12 13use Data::Model::Schema; 14use Data::Model::Schema::Inflate; 15use Data::Model::Schema::SQL; 16 17__PACKAGE__->mk_accessors(qw/ driver schema_class model class column columns index unique key options has_inflate has_deflate alias_column aluas_column_revers_map /); 18 19 20our @RESERVED = qw( 21 update save new 22 add_trigger call_trigger remove_trigger 23); 24 25 26sub new { 27 my($class, %args) = @_; 28 bless { %args }, $class; 29} 30 31sub new_obj { 32 my $self = shift; 33 $self->{class}->new(@_); 34} 35 36sub has_index { 37 $_[0]->{unique}->{$_[1]} || $_[0]->{index}->{$_[1]} 38} 39 40sub add_keys { 41 my($self, $key, %args) = @_; 42 $self->{key} = ref($key) eq 'ARRAY' ? $key : [ $key ]; 43} 44 45BEGIN { 46 for my $name (qw/ unique index /) { 47 no strict 'refs'; 48 *{"add_$name"} = sub { 49 my($self, $index, $columns, %args) = @_; 50 my $key = $columns || $index; 51 Carp::croak sprintf '%s::%s : %s name is require', $self->schema_class, $self->name, $name 52 if ref($index) || !defined $index; 53 $key = [ $key ] unless ref($key) eq 'ARRAY'; 54 $self->{$name}->{$index} = $key; 55 }; 56 } 57} 58 59sub add_column { 60 my $self = shift; 61 my($column, $type, $options) = @_; 62 return $self->add_column_sugar(@_) if $column =~ /^[^\.+]+\.[^\.+]+$/; 63 Carp::croak "Column can't be called '$column': reserved name" 64 if grep { lc $_ eq lc $column } @RESERVED; 65 66 Carp::croak 'The multiplex definition of "require" and the "required" is carried out.' 67 if exists $options->{require} && exists $options->{required}; 68 if (exists $options->{require}) { 69 $options->{required} = delete $options->{require}; 70 } 71 72 # validation for $options 73 if ($Data::Model::RUN_VALIDATION) { 74 my @p = %{ $options }; 75 validate( 76 @p, { 77 size => { 78 type => SCALAR, 79 regex => qr/\A[0-9]+\z/, 80 optional => 1, 81 }, 82 required => { 83 type => BOOLEAN, 84 optional => 1, 85 }, 86 null => { 87 type => BOOLEAN, 88 optional => 1, 89 }, 90 signed => { 91 type => BOOLEAN, 92 optional => 1, 93 }, 94 unsigned => { 95 type => BOOLEAN, 96 optional => 1, 97 }, 98 decimals => { 99 type => BOOLEAN, 100 optional => 1, 101 }, 102 zerofill => { 103 type => BOOLEAN, 104 optional => 1, 105 }, 106 binary => { 107 type => BOOLEAN, 108 optional => 1, 109 }, 110 ascii => { 111 type => BOOLEAN, 112 optional => 1, 113 }, 114 unicode => { 115 type => BOOLEAN, 116 optional => 1, 117 }, 118 default => { 119 type => SCALAR | CODEREF, 120 optional => 1, 121 }, 122 # validation => {}, 123 auto_increment => { 124 type => BOOLEAN, 125 optional => 1, 126 }, 127 inflate => { 128 type => SCALAR | CODEREF, 129 optional => 1, 130 }, 131 deflate => { 132 type => SCALAR | CODEREF, 133 optional => 1, 134 }, 135 } 136 ); 137 } 138 139 $self->{utf8_columns}->{$column} = 1 140 if delete $self->{_build_tmp}->{utf8_column}->{$column}; 141 142 push @{ $self->{columns} }, $column; 143 $self->{column}->{$column} = +{ 144 type => $type || 'char', 145 options => $options || +{}, 146 }; 147} 148sub add_utf8_column { 149 my $self = shift; 150 my($column) = @_; 151 152 $self->{_build_tmp}->{utf8_column} ||= {}; 153 $self->{_build_tmp}->{utf8_column}->{$column} = 1; 154 $self->add_column(@_); 155} 156 157sub add_alias_column { 158 my $self = shift; 159 my($base_name, $alias_name, $args) = @_; 160 $self->{aluas_column_revers_map}->{$base_name} ||= []; 161 push @{ $self->{aluas_column_revers_map}->{$base_name} }, $alias_name; 162 $self->{alias_column}->{$alias_name} = +{ 163 %{ $args || {} }, 164 base => $base_name, 165 }; 166} 167 168sub add_column_sugar { 169 my $self = shift; 170 my $name = shift; 171 my $sugar = Data::Model::Schema->get_column_sugar($self); 172 Carp::croak "Undefined column of '$name'" 173 unless exists $sugar->{$name} && $sugar->{$name}; 174 175 my $conf = $sugar->{$name}; 176 my %clone = ( 177 type => $conf->{type}, 178 options => +{ %{ $conf->{options} } }, 179 ); 180 my $column; 181 if (@_ == 0 || ref($_[0])) { 182 my $model; 183 ($model, $column) = split /\./, $name; 184 unless ($self->{model} eq $model) { 185 $column = join '_', $model, $column; 186 } 187 } else { 188 $column = shift; 189 } 190 if (@_ && ref($_[0]) eq 'HASH') { 191 $clone{options} = +{ %{ $clone{options} }, %{ ( shift ) } } 192 } 193 if (my $alias_args = delete $clone{options}->{alias}) { 194 my $rename_map = delete $clone{options}->{alias_rename} || {}; 195 while (my($alias_name, $args) = each %{ $alias_args }) { 196 $self->add_alias_column($column, $rename_map->{$alias_name} || $alias_name, $args); 197 } 198 } 199 200 $self->{utf8_columns}->{$column} = 1 201 if delete $self->{_build_tmp}->{utf8_column}->{$name}; 202 203 $self->add_column($column, $clone{type}, $clone{options}); 204} 205 206sub add_options { 207 my $self = shift; 208 if (ref($_[0]) eq 'HASH') { 209 $self->{options} = shift; 210 } elsif (!(@_ % 2)) { 211 while (my($key, $value) = splice @_, 0, 2) { 212 $self->{options}->{$key} = $value; 213 } 214 } 215} 216 217sub column_names { 218 my $self = shift; 219 @{ $self->{columns} }; 220} 221 222sub column_type { 223 my($self, $column) = @_; 224 return 'char' unless $column && $self->{column}->{$column} && $self->{column}->{$column}->{type}; 225 $self->{column}->{$column}->{type}; 226} 227sub column_options { 228 my($self, $column) = @_; 229 $self->{column}->{$column}->{options} || +{}; 230} 231 232sub setup_inflate { 233 my $self = shift; 234 235 $self->{inflate_columns} = []; 236 $self->{deflate_columns} = []; 237 238 while (my($column, $data) = each %{ $self->{column} }) { 239 my $opts = $data->{options}; 240 241 my $inflate = $opts->{inflate}; 242 if ($inflate && ref($inflate) ne 'CODE') { 243 $opts->{inflate} = Data::Model::Schema::Inflate->get_inflate($inflate); 244 $opts->{deflate} = $inflate; 245 $inflate = $opts->{inflate}; 246 } 247 if (ref($inflate) eq 'CODE') { 248 push @{ $self->{inflate_columns} }, $column; 249 $self->{has_inflate} = 1; 250 } else { 251 delete $opts->{inflate}; 252 } 253 254 my $deflate = $opts->{deflate}; 255 if ($deflate && ref($deflate) ne 'CODE') { 256 $opts->{deflate} = Data::Model::Schema::Inflate->get_deflate($deflate); 257 $deflate = $opts->{deflate}; 258 } 259 if (ref($deflate) eq 'CODE') { 260 push @{ $self->{deflate_columns} }, $column; 261 $self->{has_deflate} = 1; 262 } else { 263 delete $opts->{deflate}; 264 } 265 } 266 267 if (scalar(%{ $self->{utf8_columns} })) { 268 $self->{has_inflate} = $self->{has_deflate} = 1; 269 my @columns = keys %{ $self->{column} }; 270 $self->{inflate_columns} = \@columns; 271 $self->{deflate_columns} = \@columns; 272 } 273 274 # for alias 275 while (my($base, $list) = each %{ $self->{aluas_column_revers_map} }) { 276 for my $alias (@{ $list }) { 277 my $args = $self->{alias_column}->{$alias}; 278 my $inflate = $args->{inflate}; 279 280 if ($inflate && ref($inflate) ne 'CODE') { 281 $args->{inflate} = Data::Model::Schema::Inflate->get_inflate($inflate); 282 $args->{deflate} = Data::Model::Schema::Inflate->get_deflate($inflate); 283 } 284 285 my $inflate_code = $args->{inflate}; 286 my $is_utf8 = $args->{is_utf8}; 287 my $charset = $args->{charset} || 'utf8'; 288 289 # make inflate2alias 290 my $code; 291 292 if ($is_utf8 && $inflate_code) { 293 $code = sub { 294 $_[0]->{alias_values}->{$alias} = $inflate_code->( Encode::decode( $charset, $_[0]->{column_values}->{$base} ) ); 295 }; 296 } elsif ($is_utf8) { 297 $code = sub { 298 $_[0]->{alias_values}->{$alias} = Encode::decode( $charset, $_[0]->{column_values}->{$base} ); 299 }; 300 } elsif ($inflate_code) { 301 $code = sub { 302 $_[0]->{alias_values}->{$alias} = $inflate_code->( $_[0]->{column_values}->{$base} ); 303 }; 304 } else { 305 $code = sub { 306 $_[0]->{alias_values}->{$alias} = $_[0]->{column_values}->{$base}; 307 }; 308 } 309 $args->{inflate2alias} = $code; 310 } 311 } 312} 313 314sub inflate { 315 if ($_[0]->{has_inflate}) { 316 my($self, $columns) = @_; 317 my $orig_columns; 318 if (ref($columns) eq $self->{class}) { 319 $orig_columns = $columns; 320 $columns = $columns->{column_values}; 321 } elsif (ref($columns) ne 'HASH') { 322 Carp::croak "required types 'HASH' or '$self->{class}' of inflate"; 323 } 324 $self->call_trigger('pre_inflate', $columns, $orig_columns); 325 326 for my $column (@{ $self->{inflate_columns} }) { 327 next unless defined $columns->{$column}; 328 329 my $opts = $self->{column}->{$column}->{options}; 330 my $val = $columns->{$column}; 331 332 if ($self->{utf8_columns}->{$column}) { 333 my $charset = $opts->{charset} || 'utf8'; 334 $val = Encode::decode($charset, $val); 335 } 336 337 $val = $opts->{inflate}->($val) if ref($opts->{inflate}) eq 'CODE'; 338 339 $orig_columns->{original_cols}->{$column} ||= $orig_columns->{column_values}->{$column} 340 if $orig_columns && $columns->{$column} ne $val; 341 342 $columns->{$column} = $val; 343 } 344 $self->call_trigger('post_inflate', $columns, $orig_columns); 345 } 346} 347 348sub deflate { 349 return unless $_[0]->{has_deflate}; 350 my($self, $columns) = @_; 351 my $orig_columns; 352 if (ref($columns) eq $self->{class}) { 353 $orig_columns = $columns; 354 $columns = $columns->{column_values}; 355 } elsif (ref($columns) ne 'HASH') { 356 Carp::croak "required types 'HASH' or '$self->{class}' of inflate"; 357 } 358 $self->call_trigger('pre_deflate', $columns, $orig_columns); 359 360 for my $column (@{ $self->{deflate_columns} }) { 361 next unless defined $columns->{$column}; 362 363 my $opts = $self->{column}->{$column}->{options}; 364 my $val = $columns->{$column}; 365 $val = $opts->{deflate}->($val) if ref($opts->{deflate}) eq 'CODE'; 366 367 if ($self->{utf8_columns}->{$column}) { 368 my $charset = $opts->{charset} || 'utf8'; 369 $val = Encode::encode($charset, $val); 370 } 371 $columns->{$column} = $val; 372 } 373 $self->call_trigger('post_deflate', $columns, $orig_columns); 374} 375 376sub set_default { 377 my($self, $columns) = @_; 378 379 while (my($name, $conf) = each %{ $self->{column} }) { 380 next if exists $columns->{$name}; 381 next unless exists $conf->{options}; 382 next unless exists $conf->{options}->{default}; 383 384 my $default = $conf->{options}->{default}; 385 if (ref($default) eq 'CODE') { 386 $columns->{$name} = $default->($self, $columns); 387 } else { 388 $columns->{$name} = $default; 389 } 390 } 391} 392 393sub get_key_array_by_hash { 394 my($self, $hash, $index) = @_; 395 396 my $key; 397 $key = $self->{unique}->{$index} || $self->{index}->{$index} if $index; 398 $key ||= $self->{key}; 399 $key = [ $key ] unless ref($key) eq 'ARRAY'; 400 401 my @keys; 402 for my $key (@{ $key }) { 403 last unless defined $hash->{$key}; 404 push @keys, $hash->{$key}; 405 } 406 \@keys; 407} 408 409sub get_columns_hash_by_key_array_and_hash { 410 my($self, $hash, $array, $index) = @_; 411 my $ret = {}; 412 413 # by column 414 for my $column (keys %{ $self->{column} }) { 415 next unless exists $hash->{$column}; 416 $ret->{$column} = $hash->{$column}; 417 } 418 419 # by key 420 my $key; 421 $key = $self->{unique}->{$index} || $self->{index}->{$index} || Carp::croak "Cannot find index '$index'" if $index; 422 $key ||= $self->{key}; 423 $key = [ $key ] unless ref($key) eq 'ARRAY'; 424 425 @{ $ret }{@{ $key }} = @{ $array }; 426 $ret; 427} 428 429 430sub sql { 431 my $self = shift; 432 $self->{sql} ||= Data::Model::Schema::SQL->new($self); 433} 434 435 4361; 437