Myco
view release on metacpan or search on metacpan
lib/Myco/Entity/Meta.pm view on Meta::CPAN
}
}
# Set up default ui->widget if needed
my $values = $attr->get_values;
my $widget = $attr_ui->get_widget;
if ( defined $values and @$values
and (!defined $widget
or ! @$widget
or $widget->[0] eq 'textfield')) {
$attr_ui->set_widget( [ 'popup_menu' ]);
}
#######################################
## Enforce attrib 'readonly' nature
#######################################
if ( $attr->get_readonly ) {
no strict 'refs';
# install set_ATTRIB() blocker
my $bad_setter = 'set_'.$aname;
lib/Myco/Entity/Meta.pm view on Meta::CPAN
synopsis => "How you'd like your meat cooked",
syntax_msg => "single number: 0 through 5",
values => [qw(0 1 2 3 4, 5)],
value_labels => {0 => 'rare',
1 => 'medium-rare',
2 => 'medium',
3 => 'medium-well',
4 => 'well',
5 => 'charred'},
ui => { label => "Cook until..",
widget => [ 'popup_menu' ] },
);
Adds a Myco::Entity::Meta::Attribute object containing metadata
that describes an attribute. Valid named parameters are as follows:
=over
=item * name [required]
=item * readonly
lib/Myco/Entity/Meta/Attribute.pm view on Meta::CPAN
tangram_options => { required => 1},
synopsis => "How you'd like your meat cooked",
syntax_msg => "correct format, please!",
values => [qw(0 1 2 3 4 5)],
value_labels => {0 => 'rare',
1 => 'medium-rare',
2 => 'medium',
3 => 'medium-well',
4 => 'well',
5 => 'charred'},
ui => { widget => [ 'popup_menu' ],
label => 'Cook until...',
},
);
## Typical post-setup usage
# ...given a Myco::Entity::Meta enabled entity object $obj
my $metadata = $obj->introspect;
# Get reference to array of ::Meta::Attribute objects for $obj's class
my $attributes = $metadata->get_attributes;
lib/Myco/Entity/Meta/Attribute.pm view on Meta::CPAN
my $setter = 'set_'.$ui_attr;
$obj->get_ui->$setter( $params{ui}{$ui_attr} );
}
}
### Generate UI closure for this attribute
my $values = $obj->get_values;
my $ui = $obj->get_ui;
if (defined $values and @$values
and $using_default_meta and ! $specd_widget) {
$ui->set_widget( ['popup_menu'] );
}
# # Do metadata inheritence
# Myco::Entity::Meta->_clone_metadata(\%params, $typedef)
return $obj;
}
##############################################################################
# Attributes & Attribute Accessors / Schema Definition
lib/Myco/Entity/Meta/Attribute.pm view on Meta::CPAN
type: string
Short (under one line) description of valid entity attribute value syntax.
=head2 values
type: array ref
Array of all valid values for this entity attribute. Use only when
appropriate. By default, setting this metadata parameter results in a
"popup_menu" being used as the user interface widget type, with values
displayed in the order given.
=over 4
=item
I<Special Array Values>
The special string values below may be included as members of the array
to customize this entity attributeE<39>s user interface behavior.
These values do NOT get stored in the entity object attribute.
=over 4
=item *
__select__
Including in the array the string "__select__" will make "<Select>" appear
as a popup menu choice.
=item *
__other__
If the array contains the string "__other__" then during widget generation
the popup menu will include the choice "<Other>", and
a text box will appear below labeled "Other:" that allows entry of an
alternate value which will be used as the input value for this entity
attribute if '<Other>' is selected.
=item *
__blank__
If the array contains the string "__blank__" then the popup menu will contain
a blank selection at the given position.
=back
=back
=head2 value_labels
type: hash ref
Hash mapping entity attribute values (which should be the same as those
specified with the "values" parameter) to a user visible label; for use when
generating value selection user interface widget for this entity attribute.
=head2 ui
type: hash ref
{
label => 'Sprocket',
widget => ['popup_menu', -rows => 2, -columns => 2],
# etc.
}
A data structure containing instructions for generating a user interface
element for this entity attribute. This data structure used in the creation
of a L<Myco::Entity::Meta::Attribute::UI|Myco::Entity::Meta::Attribute::UI>
object which becomes part of the attribute metadata. Run-time access
to this metadata should only occur via accessor methods.
The following hash keys (corresponding to ::Meta::Attribute::UI object
lib/Myco/Entity/Meta/Attribute.pm view on Meta::CPAN
I<suffix>
type: string
Additional HTML that will be appended to the generated widget HTML.
I<widget>
type: array ref
['popup_menu', -rows => 2, -columns => 2]
The first array element is the name of the L<CGI.pm|CGI> form element method to
be used to generate the widget. Named parameters for this CGI.pm method
may optionally follow. Named parameters -name, -values, and -value_labels
should _not_ be specified here (these will automatically be set as
appropriate, from, for example, other metadata attributes).
Setting this attribute will trigger the automatic setting of the 'closure'
attribute.
lib/Myco/Entity/Meta/Attribute.pm view on Meta::CPAN
an appropriate user interface widget may be automatically
chosen, depending on the type of the entity attribute (as indicated in the
'type' metadata attribute). The default UI elements (L<CGI.pm|CGI> form
element method names) are listed below by major entity type categories:
=over 4
=item * scalars: textfield
(string, int, real, rawdate, etc.) If, however, the 'values' metadata
attribute is set then 'popup_menu' will be used instead.
=item * flat_array: none
=item * other: none
(ref, (i)array, (i)set, hash, dmdatetime, perl_dump)
=back
=back
lib/Myco/Entity/Meta/Attribute/UI.pm view on Meta::CPAN
use constant FIELD_MAXLEN => 20;
# Limit for visible length of texfields unless explicitly overridden
# in ui widget spec (via '-maxlength => #')
use constant FIELD_DEFSIZE => 50;
# Closures of CGI.pm form-related methods.
my $CGImethods;
{
my @_CGImethodNames = qw(button checkbox checkbox_group defaults end_form
endform filefield hidden image_button
password_field popup_menu radio_group reset
scrolling_list start_form startform submit
textarea textfield
);
my $cgi = CGI->new;
for my $meth (@_CGImethodNames) {
# create closure
my $methref = UNIVERSAL::can('CGI',$meth);
print "## No methref!!! ##\n" if (DEBUG and !defined $methref);
$CGImethods->{$meth} = sub { $methref->(@_) }
if ref $methref;
lib/Myco/Entity/Meta/Attribute/UI.pm view on Meta::CPAN
##############################################################################
our $schema =
{ fields => {
# ref => {
# attr => { required => 1 },
# },
transient => { closure => {},
label => {},
do_query => {},
popup_menu => {},
iset_box => {},
suffix => {},
attr => {},
options => { check_func => $chk_options },
widget => { check_func => $chk_widget },
},
}
};
lib/Myco/Entity/Meta/Attribute/UI.pm view on Meta::CPAN
sub set_do_query {
my ($self, $do_query) = @_;
if ($do_query && $self->get_attr->get_type) {
# Ignore the do_query directive if the attribute's not a 'ref' type
$self->SUPER::set_do_query(1) if $self->get_attr->get_type eq 'ref';
}
}
=head2 popup_menu
type: int
Boolean value (1 | 0) that flags an attribute of type 'ref' to be included
in UI generation with a popup_menu of object IDs/display names. Used primarily
by L<Myco::UI::MVC::Controller|Myco::UI::MVC::Controller>.
=cut
sub set_popup_menu {
my ($self, $popup_menu) = @_;
if ($popup_menu && $self->get_attr->get_type) {
# Ignore the popup_menu directive if the attribute's not a 'ref' type
$self->SUPER::set_popup_menu( $popup_menu )
if $self->get_attr->get_type eq 'ref';
}
}
=head2 iset_box
type: int
Name of a Myco class that flags an attribute of type 'iset' to be included
lib/Myco/Entity/Meta/Attribute/UI.pm view on Meta::CPAN
if (ref $values eq 'ARRAY' and @$values
and $cgi_meth ne 'checkbox') {
if (defined $options->{value_default}) {
$cgi_args{-default} ||= $options->{value_default};
}
$value_labels = $attr->get_value_labels || {};
# Handle @$values magic strings
my $val_select;
if ($cgi_meth eq 'popup_menu') {
for my $val (@$values) {
$val_select = 1 if $val eq '__select__';
$val_other = 1 if $val eq '__other__';
$val_blank = 1 if $val eq '__blank__';
}
$value_labels->{__other__} = '<Other>' if $val_other;
$value_labels->{__blank__} = '' if $val_blank;
$value_labels->{__select__} = '<Select>' if $val_select;
if ($val_select) {
test/Myco/Entity/Meta/Attribute/UI/Test.pm view on Meta::CPAN
type => 'int',
synopsis => "How you'd like your meat cooked",
syntax_msg => "correct format, please!",
values => [qw(__select__ 0 1 2 3 4 5)],
value_labels => {0 => 'rare',
1 => 'medium-rare',
2 => 'medium',
3 => 'medium-well',
4 => 'well',
5 => 'charred'},
ui => { widget => ['popup_menu'] }
);
my $CGI = CGI->new;
my $code = $attr->get_ui->get_closure;
$test->assert( ref $code eq 'CODE',
"ui_closure is now defined" );
my $html = $code->($CGI, '', -name=>'foo', formname=>'Zippy');
$test->db_out($html) if DEBUG;
test/Myco/Entity/Meta/Attribute/UI/Test.pm view on Meta::CPAN
$test->assert($widget->[0] eq 'textfield', 'happy widget!');
}
sub test_4_prepare_ui_string_default_w_values {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
my $CGI = CGI->new;
# Test popup_menu as default if 'values' is set
my $attr = META_ATTR->new
( name => 'name',
type => 'string',
type_options => { string_length => 32 },
synopsis => "your john hancock",
syntax_msg => "correct format, please!",
values => [qw(__select__ a b c)],
ui => { suffix => "bogus text" },
);
my $ui = $attr->get_ui;
test/Myco/Entity/Meta/Attribute/UI/Test.pm view on Meta::CPAN
'correct number of option elems');
}
sub test_5_prepare_ui_string_default_w_other_values {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
my $CGI = CGI->new;
# Test popup_menu as default if 'values' is set
my $attr = META_ATTR->new
( name => 'attr_ui_test',
type => 'string',
type_options => { string_length => 32 },
synopsis => "your john hancock",
syntax_msg => "correct format, please!",
values => [qw(a b c d e __other__)],
ui => { suffix => "bogus text", },
);
my $ui = $attr->get_ui;
test/Myco/Entity/Meta/Attribute/UI/Test.pm view on Meta::CPAN
'*otherValue_attr_ui_test correct');
}
sub test_6_prepare_ui_rawdate {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
my $CGI = CGI->new;
# Test popup_menu as default if 'values' is set
my $attr = META_ATTR->new
( name => 'name',
type => 'rawdate',
);
my $ui = $attr->get_ui;
my $code = $ui->get_closure;
my $html = $code->($CGI, '', -name=>'foo', formname=>'Zippy');
$test->db_out($html) if DEBUG;
test/Myco/Entity/Meta/Attribute/UI/Test.pm view on Meta::CPAN
$attr->set_type('string');
$attr->set_ui( undef );
$ui = $attr->get_ui;
$test->assert( ! $ui->get_do_query,
"'do_query' was ignored 'cause the attribute's not a ref" );
}
sub test_8_popup_menu_with_ref_attr {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
# Test that a CGI spec for popup_menu is handled with a ref attribute.
# Actually, the spec will be generated in MVC.
my $attr = META_ATTR->new( name => 'fool',
type => 'string',
ui => { popup_menu => 1 },
);
my $ui = $attr->get_ui;
$test->assert( ! $ui->get_popup_menu, "won't work for string attributes" );
$attr = META_ATTR->new( name => 'fool',
type => 'ref',
ui => { popup_menu => 1 },
);
$ui = $attr->get_ui;
$test->assert( $ui->get_popup_menu, "but does work for ref attributes" );
}
sub test_9_box_with_iset_attr {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
# Test that a CGI spec for a UI box handled with an iset attr
# Actually, the spec will be generated in MVC.
my $attr = META_ATTR->new( name => 'bunch-o-fools',
test/Myco/Entity/Meta/Test.pm view on Meta::CPAN
$test->assert(@{ $attr_opts->{hidden} } == 1, 'maybe one hidden attr');
$test->assert(defined $attr_opts->{hidden}[0], 'one hidden attr defined');
$test->assert($attr_opts->{hidden}[0] eq 'meat_cooked_pref',
'the expected hidden attr!');
# Did correct default widget type get set for an attrib with 'values' set?
my $widg = eval {
$meta->get_attributes->{meat_cooked_pref}-> get_ui->get_widget->[0];
};
$test->assert(! $@, "no trouble looking up widget name: $@");
$test->assert($widg eq 'popup_menu',
"got us correct default widget... or not: $widg");
}
sub test_add_attribute {
my $test = shift;
return if $test->should_skip; # skip over this test if asked
my $meta = Myco::Entity::Meta->new(name => $testpkg1);
eval { $meta->add_attribute(%$test_attr_params); };
test/Myco/Entity/Meta/Test.pm view on Meta::CPAN
$test->assert($attrmeta->get_value_labels->{3} eq 'Leghorn',
'got some chicken val labels');
$test->assert($attrmeta->get_ui->get_label eq 'Yummy',
'got some chicken ui metadata');
## Test Meta-defined inherited attribute with override
$attrmeta = $test->_grok_inherited_attrib($meta, $instance,
'color', 'string', 'blue',
'popup_menu');
# a metadatum inherited as is
$test->assert($attrmeta->get_synopsis eq 'Gimme Color',
'color synopsis happily inherited');
# After Class::Tangram overhaul - why doesn't this pass?
# snoop the override
# $test->assert($attrmeta->get_ui->get_label eq 'Gotcha!',
# 'color label happily overridden in subclass');
test/Myco/Entity/Test.pm view on Meta::CPAN
type => 'int',
synopsis => "How you'd like your meat cooked",
syntax_msg => "single number: 0 through 5",
values => [qw(0 1 2 3 4 5)],
value_labels => {0 => 'rare',
1 => 'medium-rare',
2 => 'medium',
3 => 'medium-well',
4 => 'well',
5 => 'charred'},
ui => { widget => [ popup_menu => undef ] },
};
# This class tests features of:
my $class = 'Myco::Entity';
my %test_parameters =
### Test Control Prameters ###
(
# A scalar attribute that can be used for testing... set to undef
# to disable related tests
( run in 0.921 second using v1.01-cache-2.11-cpan-364913b4093 )