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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
use strict;
package HTML::FormFu::Element::URL;
$HTML::FormFu::Element::URL::VERSION = '2.07';
# ABSTRACT: HTML5 URL form field
use Moose;
extends 'HTML::FormFu::Element';
with 'HTML::FormFu::Role::Element::Input';
use HTML::FormFu::Attribute qw( mk_output_accessors );
has http_only => ( is => 'rw', traits => ['Chained'] );
has https_only => ( is => 'rw', traits => ['Chained'] );
has error_message => (
is => 'rw',
predicate => 'has_message',
traits => ['Chained'],
);
has _has_auto_regex_constraint => (
is => 'rw',
init_arg => undef,
);
__PACKAGE__->mk_output_accessors(qw( message ));
after BUILD => sub {
my $self = shift;
$self->field_type('url');
return;
};
sub pre_process {
my ($self) = @_;
my $constraint;
if ( $self->_has_auto_regex_constraint ) {
$constraint = $self->_has_auto_regex_constraint;
}
else {
my $scheme;
if ( $self->http_only ) {
$scheme = 'http';
}
elsif ( $self->https_only ) {
$scheme = 'https';
}
else {
$scheme = 'https?';
}
$constraint = $self->constraint(
{ type => 'Regex',
common => [ 'URI', 'HTTP', { -scheme => $scheme }, ],
} );
$self->_has_auto_regex_constraint($constraint);
# 'pattern' attribute
$self->pattern("$scheme://.*");
}
my $message = $self->error_message;
if ( defined $message && length $message ) {
$constraint->message($message);
}
return;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormFu::Element::URL - HTML5 URL form field
=head1 VERSION
version 2.07
=head1 SYNOPSIS
my $element = $form->element( URL => 'foo' );
# no need to add a separate constraint
=head1 DESCRIPTION
HTML5 URL form field which provides native client-side validation in modern browsers.
Creates an input field with C<<type="url">>.
Also sets the C<pattern> attribute to restrict the client-side validation to only
our desired schemes (http and/or https).
This element automatically adds a L<Regex constraint|HTML::FormFu::Constraint::Regex>,
so you don't have to.
If neither L</http_only> or L</https_only> are set, the constraint allows any HTTP or HTTPS url.
=head1 METHODS
=head2 http_only
=head2 https_only
=head2 message
Arguments: $string
Set the error message on the L<Regex constraint|HTML::FormFu::Constraint::Regex> which is
automatically added.
=head2 message_xml
Arguments: $string
If you don't want your error message to be XML-escaped, use the L</message_xml> method
instead of L</message>.
=head2 message_loc
Arguments: $localization_key
Set the error message using a L10N key.
=head1 SEE ALSO
Is a sub-class of, and inherits methods from
L<HTML::FormFu::Role::Element::Input>,
L<HTML::FormFu::Role::Element::Field>,
L<HTML::FormFu::Element>.
L<HTML::FormFu>
=head1 AUTHOR
Carl Franks, C<cfranks@cpan.org>
=head1 LICENSE
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 AUTHOR
Carl Franks <cpan@fireartist.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Carl Franks.
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
|
