{
$Form::Toolkit::Form::VERSION
=
'0.004'
;
}
require
5.010_000;
use
Moose
-traits
=>
'Form::Toolkit::Meta::Class::Trait::HasID'
;
__PACKAGE__->meta->id_prefix(
'form_'
);
has
'jsoner'
=> (
isa
=>
'JSON'
,
is
=>
'ro'
,
required
=> 1,
lazy_build
=> 1);
has
'fields'
=> (
isa
=>
'ArrayRef[Form::Toolkit::Field]'
,
is
=>
'ro'
,
required
=> 1 ,
default
=>
sub
{ [] } ,
traits
=> [
'Clone'
]);
has
'_fields_idx'
=> (
isa
=>
'HashRef[Int]'
,
is
=>
'ro'
,
required
=> 1,
default
=>
sub
{ {} },
traits
=> [
'Clone'
]);
has
'_field_next_num'
=> (
isa
=>
'Int'
,
is
=>
'rw'
,
default
=> 0 ,
required
=> 1 ,
traits
=> [
'Clone'
]);
has
'errors'
=> (
isa
=>
'ArrayRef[Str]'
,
is
=>
'rw'
,
default
=>
sub
{ [] } ,
required
=> 1 ,
traits
=> [
'Clone'
]);
has
'submit_label'
=> (
isa
=>
'Str'
,
is
=>
'rw'
,
default
=>
'Submit'
,
required
=> 1 ,
traits
=> [
'Clone'
]);
sub
BUILD{
my
(
$self
) =
@_
;
$self
->build_fields();
}
sub
_build_jsoner{
my
(
$self
) =
@_
;
return
JSON->new->ascii(1)->pretty(0);
}
sub
fast_clone{
my
(
$self
) =
@_
;
my
$new_fields
= [
map
{
$_
->fast_clone() } @{
$self
->fields() } ];
return
bless
{
%$self
,
fields
=>
$new_fields
} , Scalar::Util::blessed(
$self
);
}
sub
id{
my
(
$self
) =
@_
;
my
(
$package
,
$filename
,
$line
) =
caller
;
warn
"Calling ->id() from $package ($filename: $line) is deprecated. Please use ->meta->id() instead"
;
return
$self
->meta->id();
}
sub
do_accept{
my
(
$self
,
$visitor
) =
@_
;
unless
(
$visitor
->can(
'visit_form'
) ){
confess(
"Visitor $visitor cannot 'visit_form'"
);
}
return
$visitor
->visit_form(
$self
);
}
sub
build_fields{}
sub
add_error{
my
(
$self
,
$error
) =
@_
;
push
@{
$self
->errors()} ,
$error
;
}
sub
add_field{
my
(
$self
,
@rest
) =
@_
;
my
$field
=
shift
@rest
;
if
(
ref
(
$field
) &&
$field
->isa(
'Form::Toolkit::Field'
) ){
return
$self
->_add_field(
$field
);
}
if
(
ref
(
$field
) ){ confess(
"Argument $field not supported"
) ; }
my
$name
=
shift
@rest
;
unless
(
$name
){
$name
=
$field
,
$field
=
'String'
; }
my
$ret
;
eval
{
my
$f_class
=
$field
;
if
(
$f_class
=~ /^\+/ ){
$f_class
=~ s/^\+//;
}
else
{
$f_class
=
'Form::Toolkit::Field::'
.
$f_class
;
}
Class::Load::load_class(
$f_class
);
my
$new_instance
=
$f_class
->new({
form
=>
$self
,
name
=>
$name
});
$ret
=
$self
->_add_field(
$new_instance
);
};
unless
( $@ ){
return
$ret
; }
confess(
"Class $field is invalid: $@"
);
}
sub
_add_field{
my
(
$self
,
$field
) =
@_
;
$field
//=
''
;
unless
(
ref
(
$field
) &&
$field
->isa(
'Form::Toolkit::Field'
) ){ confess(
"Please give a JCOM::Form::Field Instance, not a $field"
); }
if
(
$self
->field(
$field
->name()) ){
confess(
"A field named '"
.
$field
->name().
"' already exists in this form"
);
}
push
@{
$self
->fields()} ,
$field
;
$self
->_fields_idx->{
$field
->name()} =
$self
->_field_next_num();
$self
->_field_next_num(
$self
->_field_next_num() + 1);
return
$field
;
}
sub
field{
my
(
$self
,
$name
) =
@_
;
my
$idx
=
$self
->_fields_idx->{
$name
};
return
defined
$idx
?
$self
->fields->[
$idx
] :
undef
;
}
sub
is_valid{
my
(
$self
) =
@_
;
return
!
$self
->has_errors();
}
sub
has_errors{
my
(
$self
) =
@_
;
return
scalar
(@{
$self
->errors()}) ||
grep
{
$_
->has_errors } @{
$self
->fields()};
}
sub
dump_errors{
my
(
$self
) =
@_
;
my
%field_errors
=
map
{
$_
->name() =>
$_
->errors() } @{
$self
->fields()};
return
{
_form
=>
$self
->errors(),
%field_errors
};
}
sub
reset
{
goto
&clear
;
}
sub
clear{
my
(
$self
) =
@_
;
$self
->errors([]);
map
{
$_
->clear() } @{
$self
->fields()};
}
sub
values_hash{
my
(
$self
) =
@_
;
my
$ret
= {};
foreach
my
$field
( @{
$self
->fields()} ){
$ret
->{
$field
->name()} =
$field
->value_struct();
}
return
$ret
;
}
sub
litteral{
my
(
$self
) =
@_
;
return
MIME::Base64::encode_base64url(
ref
(
$self
) .
'|'
.
$self
->jsoner()->encode(
$self
->values_hash()));
}
sub
from_litteral{
my
(
$class
,
$litteral
,
$attributes
) =
@_
;
$attributes
||= {};
my
(
$fclass
,
$json
) =
split
(
'\|'
, MIME::Base64::decode_base64url(
$litteral
) , 2 );
my
$jsoner
= JSON->new();
my
$values_hash
=
$jsoner
->decode(
$json
);
Class::Load::load_class(
$fclass
);
my
$new_instance
=
$fclass
->new(
%$attributes
);
$new_instance
->fill_hash(
$values_hash
);
return
$new_instance
;
}
sub
fill_hash{
my
(
$self
,
$hash
) =
@_
;
$hash
//= {};
Form::Toolkit::Clerk::Hash->new({
source
=>
$hash
})->fill_form(
$self
);
}
__PACKAGE__->meta->make_immutable();
1;