AxKit-XSP-PerForm
view release on metacpan or search on metacpan
# $Id: PerForm.pm,v 1.24 2003/08/10 16:43:56 matt Exp $
package AxKit::XSP::PerForm;
$VERSION = "1.83";
use AxKit 1.4;
use Apache;
use Apache::AxKit::Language::XSP::TaglibHelper;
use AxKit::XSP::WebUtils 1.5;
$NS = 'http://axkit.org/NS/xsp/perform/v1';
@ISA = qw(Apache::AxKit::Language::XSP);
@EXPORT_TAGLIB = (
'textfield($name;$default,$width,$maxlength,$index,$onvalidate,$onload,$disabled,$onchange)',
'password($name;$default,$width,$maxlength,$index,$onvalidate,$onload,$disabled,$onchange)',
'submit($name;$value,$image,$alt,$border,$align,$goto,$index,$onsubmit,$disabled,$onclick)',
'cancel($name;$value,$image,$alt,$border,$align,$goto,$index,$oncancel,$disabled,$onclick)',
'checkbox($name;$value,$checked,$label,$index,$onvalidate,$onload,$disabled,$onclick)',
'file_upload($name;$value,$accept,$onvalidate,$onload,$disabled,$onclick)',
'hidden($name;$value,$index,$onload)',
'textarea($name;$cols,$rows,$wrap,$default,$index,$onvalidate,$onload,$disabled,$onchange)',
'single_select($name;$default,$index,$onvalidate,$onload,$disabled,$onchange,*options):itemtag=option',
'multi_select($name;@default,$index,$onvalidate,$onload,$disabled,$onclick,*option):itemtag=option',
);
use strict;
sub parse_char {
Apache::AxKit::Language::XSP::TaglibHelper::parse_char(@_);
}
sub parse_start {
my ($e, $tag, %attribs) = @_;
if ($tag eq 'form') {
$e->manage_text(0);
my $form_el = {
Name => "form",
NamespaceURI => "",
Attributes => [
{ Name => "name", Value => $attribs{name} },
{ Name => "method", Value => "POST" },
{ Name => "enctype", Value => "multipart/form-data" },
],
};
#MSS
# if (Apache->args) {
# $form_el->{Attributes}[1]{Value} .='?'.Apache->args;
# }
#end MSS
$e->start_element($form_el);
my $submitting = {
Name => "hidden",
NamespaceURI => "",
Attributes => [
{ Name => "name", Value => "__submitting_$attribs{name}" },
{ Name => "value", Value => "1" },
],
};
$e->start_element($submitting);
$e->end_element($submitting);
return <<EOT
{
use vars qw(\$_form_ctxt \@_submit_buttons \%_submit_goto \%_submit_index \@_cancel_buttons \%_cancel_goto \%_cancel_index );
local \$_form_ctxt = { Form => \$cgi->parms, Apache => \$r, Name => '$attribs{name}' };
local \@_submit_buttons;
local \@_cancel_buttons;
local \%_submit_goto;
local \%_cancel_goto;
local \%_submit_index;
local \%_cancel_index;
start_form_$attribs{name}(\$_form_ctxt, \$cgi->param('__submitting_$attribs{name}'))
if defined \&start_form_$attribs{name};
EOT
}
sub checkbox ($;$$$$$$$$) {
my ($name, $value, $checked, $label, $index, $onval, $onload,
$disabled, $onclick) = @_;
my ($package) = caller;
$value = 1 unless $value;
no strict 'refs';
my $ctxt = ${"${package}::_form_ctxt"};
my $params = $ctxt->{Form};
my $fname = $ctxt->{Name};
my $error;
# validate
if ($params->{"__submitting_$fname"}) {
if (my $sub = $package->can($onval || "validate_${name}")) {
eval {
$sub->($ctxt, ($params->get($name.$index))[-1], $index);
$params->{$name.$index} = ($params->get($name.$index))[-1];
};
$error = $@;
$ctxt->{_Failed}++ if $error;
$error =~ s/(.*) at .*? line \d+\.$/$1/;
}
}
# load
elsif (my $sub = $package->can($onload || "load_${name}")) {
my @vals = $sub->($ctxt, $value, ($params->get($name.$index))[-1], $index);
$checked = shift @vals;
$value = shift @vals if @vals;
}
else {
$checked = 1 if defined(($params->get($name.$index))[-1]);
}
if ($checked && $checked eq 'yes') {
$checked = 1;
}
elsif ($checked && $checked eq 'no') {
$checked = 0;
}
return {
checkbox => {
name => $name,
value => $value,
( $checked ? (checked => "checked") : () ),
label => $label,
( $error ? (error => $error) : () ),
index => $index,
($disabled ? (disabled => $disabled) : ()),
($onclick ? (onclick => $onclick) : ()),
}
};
}
sub file_upload ($;$$$$$$) {
my ($name, $value, $accept, $onval, $onload, $disabled, $onclick) = @_;
my ($package) = caller;
no strict 'refs';
my $ctxt = ${"${package}::_form_ctxt"};
my $params = $ctxt->{Form};
my $fname = $ctxt->{Name};
my $error;
# validate
if ($params->{"__submitting_$fname"}) {
if (my $sub = $package->can($onval || "validate_${name}")) {
my $upload = Apache::Request->instance(Apache->request)->upload($name);
my $filename;
if ($upload) {
$filename = $upload->filename;
$filename =~ s/.*[\\\/]//; # strip to just a filename
$filename =~ s/[^\w\.-]//g; # strip non-word chars
}
eval {
$sub->($ctxt,
($upload ?
( $filename,
$upload->fh,
$upload->size,
$upload->type,
$upload->info
) :
()
)
);
};
$error = $@;
$ctxt->{_Failed}++ if $error;
$error =~ s/(.*) at .*? line \d+\.$/$1/;
}
}
# load
elsif (my $sub = $package->can($onload || "load_${name}")) {
$params->{$name} = $sub->($ctxt, $value, $params->{$name});
}
else {
$params->{$name} = $value;
}
return {
file_upload => {
name => $name,
value => $params->{$name},
accept => $accept,
($disabled ? (disabled => $disabled) : ()),
($onclick ? (onclick => $onclick) : ()),
($error ? (error => $error) : ()),
}
};
}
sub hidden ($;$$$) {
my ($name, $value, $index, $onload) = @_;
my ($package) = caller;
no strict 'refs';
my $ctxt = ${"${package}::_form_ctxt"};
my $params = $ctxt->{Form};
my $fname = $ctxt->{Name};
if (!defined($value) && $package->can($onload || "load_${name}")) {
# load value if not defined
my $sub = $package->can($onload || "load_${name}");
$value = $sub->($ctxt, $value, $index);
}
if ($params->{"__submitting_$fname"} && ($value ne ($params->get($name.$index))[-1])) {
die "Someone tried to change your hidden form value!";
}
return {
hidden => {
name => $name,
value => $value,
index => $index,
}
};
}
sub multi_select ($;$$$$$$$) {
my ($name, $default, $index, $onval, $onload, $disabled, $onclick, $option) = @_;
my ($package) = caller;
no strict 'refs';
my $ctxt = ${"${package}::_form_ctxt"};
my $params = $ctxt->{Form};
my $fname = $ctxt->{Name};
my $error;
my ($selected, @options);
# validate
if ($params->{"__submitting_$fname"}) {
if (my $sub = $package->can($onval || "validate_${name}")) {
eval {
$sub->($ctxt, [$params->get($name.$index)], $index);
};
$error = $@;
$ctxt->{_Failed}++ if $error;
=over 4
=item Form
This is actually an Apache::Table object, so it looks and works just like an
ordinary hashref, and contains the values submitted from the form, or is
perhaps empty if the form hasn't been submitted yet. It may also contain any
parameters passed in the querystring. For multi-value parameters, they can
be accessed via Apache::Table's get, add and set methods. See
L<Apache::Table>.
=item Apache
The Apache entry is the apache request object for the current request. You
can use this, for example, to get the current URI, or to get something out
of dir_config, or perhaps to send a header. See L<Apache>.
=back
To add an entry to the context object, simply use it as a hashref:
$ctxt->{my_key} = $my_value;
And you can later get at that in another callback via C<$ctxt->{my_key}>.
=head1 ARRAYED FORM ELEMENTS
Sometimes you need to display a list of items in your form where the number
of items is not known until runtime. Use arrayed form elements to trigger
the same callback for each item in the list. When setting up each element,
use an index to identify each member of the list. The callbacks will be
passed the index as a parameter. e.g.
Your form may have a section like this:
<xsp:logic>
for $index (0..$#shoppinglist) {
<p>
<xsp:expr>$shoppinglist[$index]</xsp:expr>
<f:submit name="SubmitBuy" value="Buy me">
<f:index><xsp:expr>$index</xsp:expr></f:index>
</f:submit>
</p>
}
</xsp:logic>
The submit callback might be:
sub submit_SubmitBuy {
my ($ctxt, $index) = @_;
return "purchase.xsp?item=$index";
}
This example produces a list of items with a 'Buy me' button next to each
one. Each button has an index that corresponds an array index of an item in
the shopping list. When one of the submit buttons is pressed, the
submit_SubmitBuy callback will be triggered (as part of the submission
procedure) and the browser will redirect to a page that handles the purchase
of the associated item.
NOTE: arrays not supported for file-upload elements.
=head1 XSP INHERITANCE
Starting with AxKit 1.6.1 it is possible to specify a class which your XSP
page inherits from. All the validate, load, submit and cancel functions can
be in the class you inherit from, reducing code duplication, memory usage,
and complexity.
=head1 SPECIFYING CALLBACKS
All of the documentation here uses the default callbacks which are implied
by the name of the form element you give. Unfortunately this makes it
difficult to have multiple elements with the same validation logic without
duplicating code. In order to get around this you can manually specify the
callbacks to use.
Every main tag supports both C<onvalidate> and C<onload> attributes which
specify perl function names to validate and load respectively. Submit
buttons support C<onsubmit> attributes. Cancel buttons support C<oncancel>
attributes. Forms themselves support both C<oncancel> and C<onsubmit>
attributes.
If a form is submitted without pressing a button (such as via JavaScript,
or by hitting <Enter>, then the form tag's C<onsubmit> callback will be
used. It is always sensible to define this to be one of your button's
submit callbacks.
All tags allow a C<disabled> attribute. Set this to a true value (i.e.
C<disabled="1">) to set the control to disabled. This will be interpreted
as a HTML 4.0 feature in the default perform stylesheet.
=head1 TAG DOCUMENTATION
The following documentation uses the prefix I<f:> for all PerForm tags. This
assumes you have a namespace declaration
C<xmlns:f="http://axkit.org/NS/xsp/perform/v1"> in your XSP file.
Please note that for all of the widget tags, PerForm uses TaglibHelper. This
has the advantage that you can define attributes either as XML attributes in
the tag, or as child tags in the PerForm namespace. So:
<f:textfield name="foo" default="bar"/>
Is exactly equivalent to:
<f:textfield name="foo">
<f:default>bar</f:default>
</f:textfield>
The advantage of this is that child tags can get their content from other
XSP tags.
=head2 <f:form>
This tag has to be around the main form components. It does not have to have
any ACTION or METHOD attributes, as that is all sorted out internally. Note
that you can have as many f:form tags on a page as you want, but it probably
doesn't make sense to nest them.
B<Attributes:>
=head2 <f:checkbox/>
A checkbox.
B<Attributes:>
=over 4
=item name (mandatory)
The name of the checkbox, used to name the callback methods.
=item value
The value that gets sent to the server when this checkbox is checked.
=item checked
Set to 1 or yes to have this checkbox checked by default. Set to 0, no, or
leave off altogether to have it unchecked.
=item label
Used in HTML 4.0, the label for the checkbox. Use this with care as most
browsers don't support it.
=item index
Use this to identify the array index when using arrayed form elements.
=item onclick
This attribute is intended to be passed through to the generated
output for client-side onClick routines (usually written in javascript).
Simply specify a string as you would if writing dynamic html
forms in plain HTML.
=back
B<Callbacks:>
=over 4
=item load_<name> ( $ctxt, $current, $index )
If you implement this method, you can change the default checked state of
the checkbox, and the value returned by the checkbox if you need to.
Return one or two values. The first value is whether the box is checked or
not, and the second optional value is what value is sent to the server when
the checkbox is checked and submitted.
=item validate_<name> ( $ctxt, $value, $index )
Validate the value in the checkbox. Throw an exception to indicate
validation failure.
=back
=head2 <f:file-upload/>
A file upload field (normally in HTML, a text entry box, and a "Browse..."
button).
B<Attributes:>
=over 4
=item name (mandatory)
The name of the file upload field.
=item value
A default filename to put in the box. Use with care because putting
something in here is not very user friendly!
=item accept
A list of MIME types to accept in this dialog box. Some browsers might use
this in the Browse dialog to restrict the list of files to show.
=item onclick
This attribute is intended to be passed through to the generated
output for client-side onClick routines (usually written in javascript).
Simply specify a string as you would if writing dynamic html
forms in plain HTML.
=back
B<Callbacks:>
=over 4
=item load_<name> ( $ctxt, $default, $current )
Load a new value into the file upload field. Return the value to go in the
field.
=item validate_<name> ( $ctxt, $filename, $fh, $size, $type, $info )
Validate the uploaded file. This is also actually the place where you would
save the file to disk somewhere, by reading from $fh and writing to
somewhere else, or using File::Copy to do that for you. It is much harder to
access the file from the submit callback.
If the file is somehow invalid, throw an exception with the text of why it
is invalid.
=back
=head2 <f:hidden/>
A hidden form field, for storing persistent information across submits.
PerForm hidden fields are quite useful because they are self validating
against modification between submits, so if a malicious user tries to change
the value by editing the querystring or changing the form value somehow, the
execution of your script will die with an exception.
B<Attributes:>
=over 4
=item name (mandatory)
The name of the hidden field
=item value
The value stored in the hidden field
=item index
Use this to identify the array index when using arrayed form elements.
=back
B<Callbacks:>
=over 4
=item load_<name> ( $ctxt, $default, $index )
If you wish the value to be dynamic somehow, implement this callback and
return a new value for the hidden field.
=back
There is no validate callback for hidden fields.
=head2 <f:textarea/>
A large box of editable text.
B<Attributes:>
=over 4
=item name (mandatory)
A name for the textarea
( run in 1.227 second using v1.01-cache-2.11-cpan-b16cb0d3907 )