Bivio::ClassWrapper::TupleTag
# Copyright (c) 2009 bivio Software, Inc. All Rights Reserved. # $Id$ package Bivio::ClassWrapper::TupleTag; use strict; use Bivio::Base 'Bivio.ClassWrapper'; my($_CL); my($_FS); my($_LQ); my($_NONE); my($_NOT_NULL); my($_S); my($_SA); my($_TCL); my($_TSL); my($_TSLA); my($_TSN); my($_TST); my($_CLASSES) = {}; sub handle_class_loader_delete_require { my($self) = @_; # Have to delete packages that were wrapped, or code will be # executing that half-exists. $self->map_invoke(delete_require => [keys(%$_CLASSES)]); return; } sub wrap_methods { my($proto, $wrap_pkg, $info) = @_; _init(); #TODO: Does not work with two TupleTags (different monikers) in the same class b_die($wrap_pkg, ': already wrapped') if $_CLASSES->{$wrap_pkg}++; my($bc) = $wrap_pkg->isa('Bivio::Biz::ListFormModel') ? b_die($wrap_pkg, ': ListFormModel not supported') : $wrap_pkg->isa('Bivio::Biz::Model::ListQueryForm') ? 'ListQueryForm' : (grep($wrap_pkg->isa("Bivio::Biz::$_"), qw(FormModel ListModel PropertyModel)))[0] || b_die($wrap_pkg, ': unsupported base class'); if ($bc eq 'ListModel') { $info->{primary_id_model} = $_S->extract_model_prefix($info->{primary_id_field}) || b_die($info->{primary_id_field}, ': primary_id_field must specify model'); } $proto->SUPER::wrap_methods( $wrap_pkg, $info, $bc eq 'PropertyModel' ? { create => \&_wrap_propertymodel_x_create, } : { map({ my($re) = $_; map({ (my $x = $_) =~ s/.*_x_//; ($x => \&{$_}); } @{$proto->grep_subroutines($re)}), } qr{^_wrap_x_}, qr{^_wrap_.*$bc.*_x_}i), }, ); return; } sub handle_internal_unsafe_lc_get_value { my($proto, $fc, $name, $value) = @_; return unless $fc->equals_class_name('Text') and !$value and my $n = _parse_field($name); (my $x = $n->{field}) =~ s/_/ /g; return {value => $x}; } sub _cache { my($key, $compute) = @_; # To test with caching off # return $compute->() return $key->[0]->req->cache_for_auth_realm([(caller)[2], @$key], $compute); } sub _def_id { my($defs) = @_; return $defs->get_query->get('parent_id'); } sub _defs { my($self, $wp) = @_; return _cache([$wp], sub { my($tu) = $wp->new_other('TupleUse'); my($moniker); if (ref($wp) && $wp->can('get_tuple_use_moniker')) { $moniker = $wp->get_tuple_use_moniker; } $moniker ||= $self->get('moniker'); return undef unless $tu->unsafe_load({moniker => $moniker}); return $tu->load_tuple_slot_def_list; }); } sub _field_check { my($self, $wp, $check) = @_; return _cache([$wp, @$check], sub { return [] unless my $tsdl = _defs($self, $wp); my($labels) = _labels($self, $wp, $tsdl); return [] unless @$labels; my($moniker) = $self->get('moniker'); my($fields) = [map(_prefix($moniker, $_), @$labels)]; return $fields unless @$check; my($d) = _defs($self, $wp); return $_SA->new([ map({ _parse_slot($_) ? $d->find_row_by_field_name($_) ? _prefix($moniker, $d->get('TupleSlotDef.label')) : () : $_; } @$check), ])->intersect($fields)->as_array; }); } sub _field_info { my($self, $wp, $field, $no_die) = @_; #TODO: Needs to work with explicit ListField field values TupleTag.slot1_1 return _cache([$wp, $field], sub { return undef unless $wp->is_instance; return undef unless my $parsed = _parse_field($field) || _parse_slot($field); return $no_die ? 1 : b_die($field, ': field not found') unless my $f = _field_check($self, $wp, [$field])->[0]; $parsed = _parse_field($field = $f) if $_TSN->is_field_name($field); my($d) = _defs($self, $wp); b_die($field, ': field not found in defs??') unless $d->find_row_by_label($parsed->{field}); my($t) = $d->type_class_instance; my($c) = $d->get('TupleSlotType.choices'); my($sn) = $d->get('TupleSlotDef.tuple_slot_num'); my($moniker) = $self->get('moniker'); my($sfq) = _prefix($moniker, $_TSN->field_name($sn)); return { tuple_tag_slot_field => $_TSN->field_name($sn), tuple_tag_slot_field_qualified => $sfq, tuple_tag_slot_num => $sn, tuple_tag_label => $parsed->{field}, tuple_tag_default_value => $d->get('TupleSlotType.default_value'), name => $sfq, constraint => $d->get('TupleSlotDef.is_required') ? $_NOT_NULL : $_NONE, sort_order => $_LQ->get_sort_order_for_type($t), type => $c->is_specified ? $_TCL->new($c->as_array) : $t, $wp->isa('Bivio::Biz::FormModel') ? ( form_name => $wp->isa('Bivio::Biz::Model::ListQueryForm') ? lc("b_$parsed->{field}") : $wp->internal_get_sql_support_no_assert ->get_column_info($sfq, 'form_name'), ) : (), in_order_by => 1, }; }); } sub _labels { my($self, $wp, $tsdl) = @_; return _cache([$wp], sub { my($rsl) = $wp->new_other('RealmSettingList'); my($all) = $_TSLA->new( $tsdl->map_rows(sub {shift->get('TupleSlotDef.label')})); my($labels) = $rsl->get_setting( 'TupleTag', $wp->simple_package_name, my $moniker = $self->get('moniker'), 'TupleSlotLabelArray', $all, ); return $labels->map_iterate(sub { my($check) = @_; my($res) = @{$all->map_iterate(sub { my($label) = @_; return lc($check) eq lc($label) ? $label : (); })}; $rsl->setting_error($check, ": no such label in ", $moniker) unless $res; return $res ? $res : (); }); }); } sub _init { return if $_CL; $_CL = b_use('IO.ClassLoader'); $_FS = b_use('SQL.FormSupport'); $_LQ = b_use('SQL.ListQuery'); $_NONE = b_use('SQL.Constraint')->NONE; $_NOT_NULL = b_use('SQL.Constraint')->NOT_NULL; $_S = b_use('SQL.Support'); $_SA = b_use('Type.StringArray'); $_TCL = b_use('Type.TupleChoiceList'); $_TSL = b_use('Type.TupleSlotLabel'); $_TSLA = b_use('Type.TupleSlotLabelArray'); $_TSN = b_use('Type.TupleSlotNum'); $_TST = b_use('Type.TupleSlotType'); b_use('UI.FacadeComponent')->register_handler(__PACKAGE__); return; } sub _load_defaults { my($self, $wp, $fields) = @_; foreach my $f (@$fields) { my($i) = _field_info($self, $wp, $f); $wp->internal_put_field( $i->{tuple_tag_slot_field_qualified} => $i->{tuple_tag_default_value}); } return; } sub _load_properties { my($self, $wp, $fields) = @_; return 0 unless my $pif = $wp->unsafe_get($self->get('primary_id_field')); my($tt) = $wp->new_other('TupleTag'); return 0 unless $tt->unsafe_load({ primary_id => $pif, tuple_def_id => _def_id(_defs($self, $wp)), }); foreach my $f (@$fields) { my($i) = _field_info($self, $wp, $f); $wp->internal_put_field($i->{tuple_tag_slot_field_qualified} => $tt->get($i->{tuple_tag_slot_field})); } return 1; } sub _map_keys { my($no_die, $self, $args) = @_; my($wp) = shift(@$args); return $self->call_method([$wp, map({ my($info) = _field_info($self, $wp, $_, $no_die); $info ? ref($info) ? $info->{tuple_tag_slot_field_qualified} : "not to be found <$_>" : $_; } @$args)]); } sub _parse_field { my($field) = @_; return undef unless my $n = $_FS->parse_qualified_field($field); return undef unless $n->{model} eq 'TupleTag' && $_TSL->is_specified_literal($n->{field}); return $n; } sub _parse_slot { my($field) = @_; return undef unless my $n = $_FS->parse_qualified_field($field); return undef unless $n->{model} eq 'TupleTag' && $_TSN->is_field_name($n->{field}); return $n; } sub _prefix { my($moniker, $field) = @_; return $field ? "$moniker.TupleTag.$field" : "$moniker.TupleTag"; } sub _update_properties { my($self, $wp) = @_; my($d); unless ($d = _defs($self, $wp)) { $wp->handle_tuple_tag_update_properties() if $wp->can('handle_tuple_tag_update_properties'); return; } my($fields) = _field_check($self, $wp, []); my($v) = { primary_id => $wp->get($self->get('primary_id_field')), tuple_def_id => _def_id($d), # Need this for "just created" check realm_id => $self->req('auth_id'), }; my($tt, $exists); # If the TupleTag was just created (see _wrap_create), we need to not # override default values with undef if ($tt = $wp->ureq('Model.TupleTag')) { $tt = undef unless grep($tt->get($_) eq $v->{$_}, keys(%$v)) == keys(%$v); } unless ($tt) { $tt = $wp->new_other('TupleTag'); $exists = $tt->unsafe_load($v); } my($existing) = {%$v}; my($info) = {}; foreach my $f (@$fields) { my($i) = _field_info($self, $wp, $f); $v->{$i->{tuple_tag_slot_field}} = $wp->unsafe_get($i->{tuple_tag_slot_field_qualified}); $existing->{$i->{tuple_tag_slot_field}} = $tt->unsafe_get($i->{tuple_tag_slot_field}); $info->{$i->{tuple_tag_slot_field}} = $i; } if ($exists) { $tt->update($v); $wp->handle_tuple_tag_update_properties($existing, $v, $info) if $wp->can('handle_tuple_tag_update_properties'); return; } $d->do_rows(sub { my($it) = @_; my($n) = $_TSN->field_name($it->get('TupleSlotDef.tuple_slot_num')); $v->{$n} = $it->get('TupleSlotType.default_value') unless exists($v->{$n}); return 1; }); my($method) = $tt->is_loaded ? 'update' : 'create'; $tt->$method($v); $wp->handle_tuple_tag_update_properties($existing, $v, $info) if $wp->can('handle_tuple_tag_update_properties'); return; } sub _wrap_formmodel_x_execute_empty { my($self, $args) = @_; my($wp) = $args->[0]; my($res) = $self->call_method($args); my($fields) = _field_check($self, $wp, []); _load_defaults($self, $wp, $fields) unless !@$fields || _load_properties($self, $wp, $fields); return $res; } sub _wrap_formmodel_x_execute_ok { my($self, $args) = @_; my($wp) = $args->[0]; my($res) = $self->call_method($args); # Always update in case the record doesn't exist _update_properties($self, $wp); return $res; } sub _wrap_formmodel_listqueryform_x_internal_initialize { my($self, $args) = @_; my($wp) = $args->[0]; my($info) = $self->call_method($args); my($moniker) = $self->get('moniker'); push(@{$info->{visible} ||= []}, @{$_TSN->map_list(sub {+{ name => _prefix($moniker, shift(@_)), type => $_TST, }})}, ); return $info; } sub _wrap_listmodel_x_internal_initialize { my($self, $args) = @_; my($wp) = $args->[0]; my($info) = $self->call_method($args); my($moniker) = $self->get('moniker'); push(@{$info->{order_by} ||= []}, @{$_TSN->map_list(sub {_prefix($moniker, shift(@_))})}, ); return $info; } sub _wrap_listmodel_x_internal_prepare_statement { my($self, $args) = @_; my($wp, $stmt) = @$args; my($pif, $pim, $moniker) = $self->get(qw(primary_id_field primary_id_model moniker)); $stmt->from( $stmt->LEFT_JOIN_ON($pim, , _prefix($moniker), [ [$pif, _prefix($moniker, 'primary_id')], ]), ); if ($wp->can('LIST_QUERY_FORM_CLASS') and my $qf = $wp->ureq($wp->LIST_QUERY_FORM_CLASS) ) { foreach my $field ($qf->tuple_tag_field_check) { if (defined(my $v = $qf->unsafe_get($field))) { $stmt->where([$qf->get_field_info($field, 'name'), [$v]]) if defined($v); } } } return $self->call_method($args); } sub _wrap_listqueryform_x_get_select_attrs { my($self, $args) = @_; my($wp, $field) = @$args; return $self->call_method($args) unless my $info = _field_info($self, $wp, $field); return { field => $info->{name}, choices => $info->{type}, unknown_label => $info->{tuple_tag_label}, }; } sub _wrap_propertymodel_x_create { my($self, $args) = @_; my($wp) = $self->call_method($args); if (my $d = _defs($self, $wp)) { # See _update_properties for special case $wp->new_other('TupleTag')->create({ primary_id => $wp->get($self->get('primary_id_field')), tuple_def_id => _def_id($d), @{$d->map_rows(sub { my($it) = @_; return ($it->field_from_num => $it->get('TupleSlotType.default_value')); })}, }); } return $wp; } sub _wrap_x_get { return _map_keys(0, @_); } sub _wrap_x_get_field_error { return _map_keys(1, @_); } sub _wrap_x_get_field_info { my($self, $args) = @_; my($wp, $field, $which) = @$args; return $self->call_method($args) unless my $info = _field_info($self, $wp, $field); return $which ? $info->{$which} : $info; } sub _wrap_x_has_fields { return _map_keys(1, @_); } sub _wrap_x_has_keys { return _map_keys(1, @_); } sub _wrap_x_tuple_tag_field_check { my($self, $args) = @_; return @{_field_check($self, shift(@$args), $args)}; } sub _wrap_x_unsafe_get { return _map_keys(1, @_); } sub _wrap_x_get_info { my($self, $args) = @_; my($wp, $which) = @$args; my($res) = $self->call_method($args); return $res unless ($which || '') =~ /_names$/ && $wp->is_instance; return [map({ my($info) = _field_info($self, $wp, $_, 1); $info ? ref($info) ? $info->{tuple_tag_slot_field_qualified} : () : $_; } @$res)]; } sub _wrap_x_get_keys { my($self, $args) = @_; my($wp) = @$args; my($res) = $self->call_method($args); return [map({ my($info) = _field_info($self, $wp, $_, 1); $info ? ref($info) ? $info->{tuple_tag_slot_field_qualified} : () : $_; } @$res)]; } 1;