=head1 DESCRIPTION This package lets you create very powerful html forms. Unless noted otherwise, all the functions creating input elements accept an optional additional argument which must be a hashref with additional attribute => value pairs to use in the resulting element (see the similar functions in L. The C attribute can optionally be overriden. =over 4 =cut use utf8; use Carp (); use Convert::Scalar (); my $EF_KEY; # key within forms my $EF_FORM; # key among forms my $ef_args; my $ef_key; my $ef_recurse; my $ef_stateid; # stateid of currently open form my $ef_form; # the reference to the form html tag sub ef_nextid($;$) { $EF_KEY or Carp::croak "editform called without outside ef_begin/ef_end calls\n"; $ef_key = $_[1]{name} ||= $EF_KEY++; $ef_args->{"/"}{$ef_key} = $_[0] ? { ref => $_[0] } : { }; $ef_key; } =item ef_mbegin [surl-arguments] Start an editform. This directive outputs the

header (using C). The arguments are treated exactly like PApp::surl arguments. If it contains callbacks or similar commands, then these will be executed AFTER the form has been processed. If, inside C/C, another form is embedded, the outside form will automatically be upgraded (sbegin < cbegin < mbegin) to the most powerful form required by the forms and the nested forms are integrated into the surrounding form. Please note that this doesn't work when you change the module, as only the outside C call will have the module name honoured, so always use a C to do this, or things will go very wrong. NOTE: editform does not currently check wether a nested form specifies a module name. Behaviour in this case is undefined, and will most likely result in an obscure error from surl. =item ef_sbegin [surl-arguments] Similar to C, but uses C to create the form. =item ef_cbegin [surl-arguments] Similar to C, but uses C to create the form. =item ef_begin [surl-arguments] Identical to C, just for your convinience, as this is the form most often used. =item ef_end Ends the editform. This adds the closing tag. =cut sub _ef_parse_begin($) { my $ef = shift; $ef->{exec} = []; } sub _ef_parse_end($) { my $ef = shift; exists $ef->{"/"}{a}{value} or fancydie "form data rejected", "guard field missing (incomplete submit?)"; &$_ for @{$ef->{cb_begin}}; my @surlargs; for my $field (values %{$ef->{"/"}}) { if (exists $field->{submit}) { push @surlargs, delete $field->{submit} if $field->{submit} && delete $field->{value}; } elsif (exists $field->{checkbox}) { if ($field->{checkbox}) { if (delete $field->{value}) { ${$field->{ref}} = Agni::or64 ${$field->{ref}}, $field->{checkbox}; } else { ${$field->{ref}} = Agni::andnot64 ${$field->{ref}}, $field->{checkbox}; } } else { ${$field->{ref}} = ! ! delete $field->{value}; } } elsif (exists $field->{multi}) { ${$field->{ref}} = delete $field->{value} || []; } elsif (exists $field->{ref}) { ${$field->{ref}} = delete $field->{value} if exists $field->{value}; ${$field->{ref}} = $field->{constant} if exists $field->{constant}; } } &$_ for @{$ef->{cb_end}}; PApp::set_alternative $_ for @surlargs; } sub _ef_parse_field($$$) { my ($field, $data, $charset) = @_; if (exists $field->{submit}) { $field->{value} = 1; } elsif (exists $field->{ref}) { if ($charset) { $charset = lc $charset; if ($charset eq "utf-8") { Convert::Scalar::utf8_on $data; } elsif ($charset !~ /^(?:|ascii|us-ascii|iso-8859-1)$/) { my $pconv = PApp::Recode::Pconv::open PApp::CHARSET, $charset or fancydie "charset conversion from $charset not available"; $data = Convert::Scalar::utf8_on $pconv->convert($data); } $data =~ s/\r//g; } if (exists $field->{map}) { $data = $data >= 0 && $data < @{$field->{map}} ? $field->{map}[$data] : fancydie "form data rejected", "security violation: selectbox value out of range"; } if (exists $field->{multi}) { push @{$field->{value}}, $data; } elsif (exists $field->{checkbox}) { $field->{value} = 1; } elsif (exists $field->{password}) { $field->{value} = $data unless ($data eq "" || $data eq $field->{password}); } else { $field->{value} = $data; } } } sub ef_parse_simple { my $ef = shift; _ef_parse_begin($ef); for my $name (keys %P) { if (exists $ef->{"/"}{$name}) { my $field = $ef->{"/"}{$name}; my $data = $P{$name}; #FIXME# was delete $P, but that's not good for debugging#d# if (exists $field->{path}) { fancydie "file upload widgets are not supported with either ef_sbegin or ef_cbegin/ef_begin, use ef_mbegin instead"; } else { for $data (ref $data ? @$data : $data) { $data =~ s/\r//g; _ef_parse_field ($field, $data, $state{papp_lcs}); } } } } _ef_parse_end($ef); } my $ef_parse_s = register_callback { $request->query_string ne "" or fancydie "missing form data: query string empty"; &ef_parse_simple; } name => "papp_ef_s"; my $ef_parse_c = register_callback { $request->header_in("Content-Type") eq "application/x-www-form-urlencoded" or fancydie "missing form data: application/x-www-form-urlencoded expected, but none found"; &ef_parse_simple; } name => "papp_ef_c"; my $ef_parse_m = register_callback { my $ef = shift; _ef_parse_begin($ef); parse_multipart_form { my ($fh, $name, $ct, $cta, $cd) = @_; if (my $field = $ef->{"/"}{$name}) { if (exists $field->{path}) { my $dest; my $path = $field->{path}; # $ct eq "multipart/mixed" then multipart-file-upload # would just need to recycle PApp::FormBuffer $path = $path->($fh, $name, $ct, $cta, $cd) if ref $path; return 0 unless defined $path; # skip unless defined if (ref $path) { $dest = $path; undef $path; } else { open $dest, ">", "$path~" or return 0; } my $size = 0; my $data; while ($fh->read($data, 64*1024) > 0) { $size += syswrite $dest, $data; } close $dest; if ($size > 0) { rename "$path~", $path if defined $path; # ok if rename worked } else { unlink "$path~" if defined $path; # empty file upload ignored } } else { my $data; $fh->read($data, 1024*128); $data =~ s/\r\n$//; my $charset = $ct =~ /^text\// ? $cta->{charset} : undef; _ef_parse_field($field, $data, $charset); } } else { fancydie "form data rejected", "data received for illegal field '$name'"; } return 1; } or fancydie "missing form data: multipart/form-data expected, but none posted"; _ef_parse_end($ef); } name => "papp_ef_m"; sub _ef_begin { my $type = pop; my $attr = ref $_[0] eq "HASH" ? shift : {}; if ($ef_recurse && $PApp::stateid == $ef_stateid) { $ef_recurse++; $ef_type ||= $type; $ef_args->{attr} = { %$attr, %{$ef_args->{attr}} }; push @{$ef_args->{args}}, @_; return ""; } else { $EF_FORM = "a" if $ef_stateid != $PApp::stateid; $ef_recurse = 1; $ef_stateid = $PApp::stateid; $ef_type = $type; $EF_KEY = "a"; $ef_args = { attr => $attr, args => [@_], }; ($html, $ef_form) = fixup_marker; return $html . hidden ef_nextid(\$ef_args->{guard}), "ä"; } } sub ef_sbegin* { _ef_begin @_, 1 } sub ef_cbegin* { _ef_begin @_, 2 } sub ef_mbegin* { _ef_begin @_, 4 } # sub ef_begin* { # hack to get it exported *ef_begin = *ef_cbegin; sub ef_end* { $ef_recurse or Carp::croak "ef_end called but no form is open"; if (--$ef_recurse) { ""; } else { my @args = (delete $ef_args->{attr}, @{delete $ef_args->{args}}); $$ef_form = $ef_type & 4 ? multipart_form @args, $ef_parse_m->($ef_args) : $ef_type & 2 ? cform @args, $ef_parse_c->($ef_args) : $ef_type & 1 ? sform @args, $ef_parse_s->($ef_args) : Carp::croak "editform: internal error, ef_type is $ef_type"; # delete $ef_args->{radioref}; undef $ef_args; # important for database accessors undef $EF_KEY; (fixup_marker endform)[0]; } } =item ef_edit [group] [DEPRECATED] Returns wether the global edit-mode is active (i.e. if C<$S{ef_edit}> is true). If the argument C is given, additionally check for the stated access right. =cut sub ef_edit*(;$) { $S{ef_edit} and (!@_ or access_p $_[0]); } =item ef_may_edit [DEPRECATED] Display a link that activates or de-activates global edit-mode (see C). =cut ]]>

undef, : slink __"[Enter Edit Mode]", ef_edit => 1; ]]> is C or omitted, __"Save Changes" is used. The rest of the arguments is interpreted in exactly the same way as the arguments to C, with one exception: if no destination module is given, the module destination from the C macro is used instead of overwriting the destination with the module (as C usually does). The surl-args are interpreted after callbacks specified via L. =item ef_reset [\%attrs,] [$value] Output a reset button. If C<$value> is omitted, __"Restore Values" is used. =cut ]]> {"/"}{$key}{submit} = @_ ? &PApp::salternative : undef; submit $attr, $key, $value; ]]> a field name within the editform. If the name is omitted it returns a newly generated name. You are responsible for creating an input element with the given name. Since it doesn't generate an HTML element it will of course not accept an \%attrs hash. This can be used to implement custom input elements: my $name = ef_field \$self->{value}; echo tag "input", { name => $name }; =item ef_string fieldref, [length=20] Output a text input field. =item ef_password fieldref, [length=20, [display]] Output a non-readable text input field. To ensure that it is not readable, a C string will be used as value (the reference won't be read), and the field will be assigned only when the submitted string is non-empty and different to the C string. The default C string is the empty string. Whatever you chose for the display string, it cannot be entered as a valid password (spaces are a good choice). =item ef_text fieldref, width, [height] Output a textarea tag with the given C (if C is omitted C tries to be intelligent). =item ef_checkbox fieldref[, bitmask] Output a checkbox. If C is missing, C is evaluated as a normal perl boolean. Otherwise, the C is used to set or clear the given bit in the C. =item ef_radio fieldref, value Output a single radiobox that stores, when checked and submitted, "value" in fieldref. Be careful to use the same fieldref for all radioboxes or overwrite the name manually. C is compared to "value" using C. =item ef_button fieldref Output an input button element. =item ef_hidden fieldref Output a field of type "hidden" (see also C for a way to specify constants that cannot be altered by the client, as C cannot guarentee this). =cut ]]> $_[1] }); ]]> {size} ||= $_[1]||20; textfield $attr, ef_nextid($_[0], $attr), ${$_[0]}; ]]> {size} ||= $_[1]||20; my $id = ef_nextid($_[0], $attr); $ef_args->{"/"}{$id}{password} = "$_[2]"; password_field $attr, $id, "$_[2]"; ]]> {cols} ||= $_[1]; $attr->{rows} ||= $_[2] > 0 ? $_[2] : int (length ${$_[0]} / ($attr->{cols}-5.0001)) - $_[2] + (${$_[0]} =~ y/\n/\n/); $attr->{wrap} ||= 'wrap'; textarea $attr, ef_nextid($_[0], $attr), escape_html ${$_[0]}; ]]> {checked} = "checked" if $_[1] ? Agni::and64 ${$_[0]}, $_[1] : ${$_[0]}; my $id = ef_nextid($_[0], $attr); $ef_args->{"/"}{$id}{checkbox} = $_[1]; checkbox $attr, $id; ]]> {checked} = "checked" if ${$_[0]} eq $_[1]; $attr->{name} ||= $ef_args->{radioref}{$_[0]}; my $id = ef_nextid($_[0], $attr); $ef_args->{radioref}{$_[0]} = $id; radio $attr, $id, $_[1]; ]]> ... can be as many C pairs as you like. Beginning with version 0.143 of PApp, C (and other functions that use it, like C) don't send the key values to the client, but instead enumerate them and check wether submitted values are in range. This has two consequences: first, the client can only submit valid keys, and second, keys can be complex perl objects (like undef ;), where they could only be strings earlier. Only arrayrefs need to be treated differently. Equality of key values (used to find the currently "active" selection) is done by string comparison after stringifying the keys. =cut ]]> {multiple} = "multiple"; $ef_args->{"/"}{$id}{multi} = 1; } else { $content{$content} = (); } my $options; for (my $i = 0; $i < $#$values; $i += 2) { push @{$ef_args->{"/"}{$id}{map}}, $$values[$i]; $options .= "" . (escape_html $$values[$i+1]) . ""; } xmltag "select", $attr, $options; ]]> value]... Output relation, e.g. an selectbox with values from a sql table. C is an arrayref containing a string (and optionally arguments) for a select statement that must output key => value pairs. The values will be used as display labels in an selectbox and the corresponding key will be stored in the result field. Examples: ef_relation \$field, ["id, name from manufacturer order by 2"]; ef_relation \$field, ["game_number, game_name from games where game_name like ?", "A%"]; Additional C => C pairs can be appended and will be used. =item ef_set fieldref, [ table => "column" ] [mysql-specific] Similar to C, but is based on the SQL SET type, i.e. multiple selections are possible. The field value must be of type "arrayref" for this to work. Example: ef_set \$field, [game => "categories"]; =item ef_enum fieldref, [ table => "column" ] [mysql-specific] Similar to C, but is based on the ENUM type in sql. ef_set \$field, [game => "type"]; =cut ]]> [0]; my ($dbh, $sel, @arg) = @$relation; my $st = sql_uexec $dbh, \my($id,$val), "select $sel", @arg; while ($st->fetch) { Convert::Scalar::utf8_on $val if Convert::Scalar::utf8_valid $val; push @values, $id => $val; } ef_selectbox $attr, $field, \@values; ]]> fetchrow_arrayref->[1]; $type =~ s/^set\('(.*)'\)$/$1/ or die "ef_set: field '$fild' is not of set type\n"; ef_selectbox $attr, $field, map {$_, $_} split /','/, $type; ]]> fetchrow_arrayref->[1]; $type =~ s/^enum\('(.*)'\)$/$1/ or die "ef_enum: field '$fild' is not of enum type\n"; ef_selectbox $attr, $field, map {$_, $_} split /','/, $type; ]]> . If C is a coderef it will be executed like this: $res = $callback->($fh, $name, $ct, $cta, $cd); (see C, which uses the exact same parameters). The return value can be undefined, in which case the file will be skipped, a normal string which will be treated as a path to store the file to or something else, which will be used as a file-handle. If a destination path is given, the file will be replaced atomically (by first writing a file with a prepended "~" and renaming (success case) or unlinking it). Although a source path can be given, most browsers will ignore it. Some will display it, but not use it, so it's a rather useless feature. C automatically upgrades the surrounding form to a multipart form. =cut ]]> {"/"}{$id}{path} = $_[0]; filefield $attr, $id, $_[1]; ]]> . This is useful when creating a database row and some of the fields need to be set to a constant value. The user cannot change this value in any way. Since this function doesn't output an html tag it doesn't make sense to prepend an initial hashref with additonal name => value pairs. =cut ]]> {"/"}{$id}{constant} = $value; ]]> {cb_begin}}, $cb; ]]> {cb_end}}, $cb; ]]> {cb_end}}, $cb; ]]> attribute to the opening form tag and returns the id value to the caller. You can call it as often as you like. If this function isn't called, no name attribute will be created. =cut ]]> {attr}{name} ||= $EF_FORM++; ]]> . =head1 AUTHOR Marc Lehmann http://www.goof.com/pcg/marc/ =cut ]]>