1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
package HTML::FormHandler::Widget::ApplyRole;
# ABSTRACT: role to apply widgets
use Moose::Role;
use File::Spec;
use Class::MOP;
use Try::Tiny;
use Class::Load qw/ load_optional_class /;
use namespace::autoclean;
our $ERROR;
sub apply_widget_role {
my ( $self, $target, $widget_name, $dir ) = @_;
my $render_role = $self->get_widget_role( $widget_name, $dir );
$render_role->meta->apply($target) if $render_role;
}
sub get_widget_role {
my ( $self, $widget_name, $dir ) = @_;
my $widget_class = $self->widget_class($widget_name);
my $ldir = $dir ? '::' . $dir . '::' : '::';
my $widget_ns = $self->widget_name_space;
my @name_spaces = @$widget_ns;
push @name_spaces, ('HTML::FormHandler::Widget', 'HTML::FormHandlerX::Widget');
my @classes;
if ( $widget_class =~ s/^\+// )
{
push @classes, $widget_class;
}
foreach my $ns (@name_spaces) {
push @classes, $ns . $ldir . $widget_class;
}
foreach my $try (@classes) {
return $try if load_optional_class($try);
}
die "Can't find $dir widget $widget_class from " . join(", ", @name_spaces);
}
# this is for compatibility with widget names like 'radio_group'
# RadioGroup, Textarea, etc. also work
sub widget_class {
my ( $self, $widget ) = @_;
return unless $widget;
if($widget eq lc $widget) {
$widget =~ s/^(\w{1})/\u$1/g;
$widget =~ s/_(\w{1})/\u$1/g;
}
return $widget;
}
use namespace::autoclean;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Widget::ApplyRole - role to apply widgets
=head1 VERSION
version 0.40057
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
