Update of /cvsroot/twiki/twiki/lib/TWiki
In directory usw-pr-cvs1:/tmp/cvs-serv16136/lib/TWiki
Added Files:
Form.pm
Log Message:
Form processing.
--- NEW FILE ---
package TWiki::Form;
use strict;
# ============================
sub getFormName
{
my( @meta ) = @_;
my $form = "";
my $oldargsr;
( $oldargsr, @meta ) = &TWiki::Store::metaExtract( "FORM", "", "", @meta );
my @oldargs = @$oldargsr;
if( @oldargs ) {
my %args = @oldargs;
$form = $args{"name"};
}
return $form;
}
# ============================
# Get definition from supplied topic text
sub getFormDefinition
{
my( $text ) = @_;
my @fields = ();
my $inBlock = 0;
# | *Name:* | *Type:* | *Size:* | *Value:* | *Tooltip message:* |
foreach( split( /\n/, $text ) ) {
if( /^\s*\|.*Name[^|]*\|.*Type[^|]*\|.*Size[^|]*\|/ ) {
$inBlock = 1;
} else {
# Only insist on first field being present FIXME - use oops page instead?
if( $inBlock && s/^\s*\|//o ) {
my( $title, $type, $size, $vals, $tooltip ) = split( /\|/ );
$title =~ s/^\s*//go;
$title =~ s/\s*$//go;
my $name = _cleanField( $title );
$type = lc $type;
$type =~ s/[^a-z+]//go;
$type = "text" if( ! $type );
$size = _cleanField( $size );
if( ! $size ) {
$size = ( $type eq "text" ) ? 20 : 1;
}
$size = 1 if( ! $size );
$vals =~ s/^\s*//go;
$vals =~ s/\s*$//go;
$vals =~ s/"//go; # " would break parsing off META variables
$tooltip =~ s/^\s*//go;
$tooltip =~ s/^\s*//go;
# FIXME object if too short
push @fields, [ $name, $title, $type, $size, $vals, $tooltip ];
} else {
$inBlock = 0;
}
}
}
return @fields;
}
# ============================
sub _cleanField
{
my( $text ) = @_;
$text = "" if( ! $text );
$text =~ s/[^A-Za-z0-9_]//go;
return $text;
}
# ============================
# Possible field values for select, checkbox, radio from supplied topic text
sub getPossibleFieldValues
{
my( $text ) = @_;
my @defn = ();
my $inBlock = 0;
foreach( split( /\n/, $text ) ) {
if( /^\s*\|.*Name[^|]*\|/ ) {
$inBlock = 1;
} else {
if( /^\s*\|\s*([^|]*)\s*\|/ ) {
my $item = $1;
$item =~ s/\s+$//go;
$item =~ s/^\s+//go;
if( $inBlock ) {
push @defn, $item;
}
} else {
$inBlock = 0;
}
}
}
return @defn;
}
# ============================
# Get array of field definition, given form name
sub getFormDef
{
my( $webName, $form ) = @_;
my @fieldDefs = ();
# Read topic that defines the form
if( &TWiki::Store::topicExists( $webName, $form ) ) {
my( $text, @meta ) = &TWiki::Store::readWebTopicNew( $webName, $form );
@fieldDefs = getFormDefinition( $text );
} else {
# FIXME - do what if there is an error?
}
my @fieldsInfo = ();
# Get each field definition
foreach my $fieldDefP ( @fieldDefs ) {
my @fieldDef = @$fieldDefP;
my( $name, $title, $type, $size, $posValuesS, $tooltip ) = @fieldDef;
my @posValues = ();
if( $posValuesS ) {
@posValues = split( /,\s*/, $posValuesS );
}
if( ( ! @posValues ) && &TWiki::Store::topicExists( $webName, $name ) ) {
my( $text, @meta ) = &TWiki::Store::readWebTopicNew( $webName, $name );
@posValues = getPossibleFieldValues( $text );
if( ! $type ) {
$type = "select"; #FIXME keep?
}
} else {
# FIXME no list matters for some types
}
push @fieldsInfo, [ ( $name, $title, $type, $size, $tooltip, @posValues ) ];
}
return @fieldsInfo;
}
# ============================
sub link
{
my( $web, $name, $tooltip, $heading, $align, $span, $extra ) = @_;
$name =~ s/[\[\]]//go;
my $cell = "td";
if( $heading ) {
$cell = "th bgcolor=\"#99CCCC\"";
}
if( !$align ) {
$align = "";
} else {
$align = " align=\"$align\"";
}
if( $span ) {
$span = " colspan=$span";
} else {
$span = "";
}
my $link = "$name";
if( &TWiki::Store::topicExists( $web, $name ) ) {
if( ! $tooltip ) {
$tooltip = "Click to see details in separate window";
}
$link = "<a target=\"$name\" " .
"onClick=\"return launchWindow('%WEB%','$name')\" " .
"title=\"$tooltip\" " .
"href=\"%SCRIPTURLPATH%/view%SCRIPTSUFFIX%/%WEB%/$name\">$name</a>";
} elsif ( $tooltip ) {
$link = "<span title=\"$tooltip\">$name</span>";
}
my $html = "<$cell$span$align>$link $extra</$cell>";
return $html;
}
# ============================
# Render form information
sub renderForEdit
{
my( $web, $form, $metap, @fieldsInfo ) = @_;
my $text = "<table border=\"1\" cellspacing=\"0\" cellpadding=\"0\">\n <tr>" .
&link( $web, $form, "", "h", "", 2 ) . "</tr>\n";
my @meta = @$metap;
foreach my $c ( @fieldsInfo ) {
my @fieldInfo = @$c;
my $fieldName = shift @fieldInfo;
my $name = $fieldName . "FLD";
my $title = shift @fieldInfo;
my $type = shift @fieldInfo;
my $size = shift @fieldInfo;
my $tooltip = shift @fieldInfo;
my @ident = ( "name" => $fieldName );
my( $oldargsr, @meta ) = &TWiki::Store::metaExtract( "FIELD", \@ident, "", @meta );
my @oldargs = @$oldargsr;
my %args = @oldargs;
my $value = $args{"value"} || "";
my $extra = "";
if( $type eq "text" ) {
$value = "<input name=\"$name\" type=\"input\" value=\"$value\">";
} elsif( $type eq "select" ) {
my $val = "";
my $matched = "";
my $defaultMarker = "%DEFAULTOPTION%";
foreach my $item ( @fieldInfo ) {
my $selected = $defaultMarker;
if( $item eq $value ) {
$selected = " selected";
$matched = $item;
}
$defaultMarker = "";
$val .= " <option name=\"$item\"$selected>$item</option>";
}
if( ! $matched ) {
$val =~ s/%DEFAULTOPTION%/ selected/go;
} else {
$val =~ s/%DEFAULTOPTION%//go;
}
$value = "<select name=\"$name\" size=\"$size\">$val</select>";
} elsif( $type =~ "^checkbox" ) {
if( $type eq "checkbox+buttons" ) {
my $boxes = $#fieldInfo + 1;
$extra = "<br>\n<input type=\"button\" value=\" Set \" onClick=\"checkAll(this, 2, $boxes, true)\"> \n" .
"<input type=\"button\" value=\"Clear\" onClick=\"checkAll(this, 1, $boxes, false)\">\n";
}
my $val ="<table cellspacing=\"0\" cellpadding=\"0\"><tr>";
my $lines = 0;
foreach my $item ( @fieldInfo ) {
my $flag = "";
if( $value =~ /(^|,\s*)$item(,|$)/ ) {
$flag = "checked";
}
$val .= "\n<td><input type=\"checkbox\" name=\"$name$item\" $flag>$item </td>";
if( $size > 0 && ($lines % $size == $size - 1 ) ) {
$val .= "\n</tr><tr>";
}
$lines++;
}
$value = "$val\n</tr></table>\n";
} elsif( $type eq "radio" ) {
my $val = "<table cellspacing=\"0\" cellpadding=\"0\"><tr>";
my $matched = "";
my $defaultMarker = "%DEFAULTOPTION%";
my $lines = 0;
foreach my $item ( @fieldInfo ) {
my $selected = $defaultMarker;
if( $item eq $value ) {
$selected = " checked";
$matched = $item;
}
$defaultMarker = "";
$val .= "\n<td><input type=\"radio\" name=\"$name\" value=\"$item\" $selected>$item </td>";
if( $size > 0 && ($lines % $size == $size - 1 ) ) {
$val .= "\n</tr><tr>";
}
$lines++;
}
if( ! $matched ) {
$val =~ s/%DEFAULTOPTION%/ checked/go;
} else {
$val =~ s/%DEFAULTOPTION%//go;
}
$value = "$val\n</tr></table>\n";
}
$text .= " <tr> " . &link( $web, $title, $tooltip, "h", "right", "", $extra ) . "<td align=\"left\"> $value </td> </tr>\n";
}
$text .= "</table>\n";
return $text;
}
# =============================
sub getFormInfoFromMeta
{
my( $webName, @meta ) = @_;
my @fieldsInfo = ();
my $oldargsr;
( $oldargsr, @meta ) = &TWiki::Store::metaExtract( "FORM", "", "", @meta );
my @oldargs = @$oldargsr;
if( @oldargs ) {
my %args = @oldargs;
my $form = $args{"name"};
@fieldsInfo = getFormDef( $webName, $form );
}
return @fieldsInfo;
}
# =============================
# Meta to hidden form params
# Note that existing meta information for fields is removed
sub fieldVars2Meta
{
my( $webName, $query, @meta ) = @_;
@meta = &TWiki::Store::metaRemove( "FIELD", @meta );
my @fieldsInfo = getFormInfoFromMeta( $webName, @meta );
my $order = 0; # Used to ensure order of fields, FIXME
foreach my $fieldInfop ( @fieldsInfo ) {
my @fieldInfo = @$fieldInfop;
my $fieldName = shift @fieldInfo;
my $title = shift @fieldInfo;
my $type = shift @fieldInfo;
my $size = shift @fieldInfo;
my $value = "";
$value = $query->param( $fieldName . "FLD" );
if( ! $value && $type =~ "^checkbox" ) {
foreach my $name ( @fieldInfo ) {
if( $query->param( "$fieldName" . "FLD$name" ) ) {
$value .= ", " if( $value );
$value .= "$name";
}
}
}
# Have title and name stored so that topic can be view without reading in form definition
my @args = ( "order" => sprintf( "%02d", $order ),
"name" => $fieldName,
"title" => $title,
"value" => $value );
@meta = &TWiki::Store::metaUpdate( "FIELD", \@args, "name", @meta);
$order++;
}
return @meta;
}
# =============================
sub getFieldParams
{
my( @meta ) = @_;
my $params = "";
foreach my $metaItem( @meta ) {
if( $metaItem =~ /(%META:FIELD\{)([^\}]*)(}%)/ ) {
my $args = $2;
my $name = &TWiki::extractNameValuePair( $args, "name" );
my $value = &TWiki::extractNameValuePair( $args, "value" );
$name .= "FLD";
$params .= "<input type=\"hidden\" name=\"$name\" value=\"$value\">\n";
}
}
return $params;
}
# ============================
# load old style category table item
sub upgradeCategoryItem
{
my ( $catitems, $ctext ) = @_;
my $catname = "";
my $scatname = "";
my $catmodifier = "";
my $catvalue = "";
my @cmd = split( /\|/, $catitems );
my $src = "";
my $len = @cmd;
if( $len < "2" ) {
# FIXME
return ( $catname, $catmodifier, $catvalue )
}
my $svalue = "";
my $i;
my $itemsPerLine;
# check for CategoryName=CategoryValue parameter
my $paramCmd = "";
my $cvalue = ""; # was$query->param( $cmd[1] );
if( $cvalue ) {
$src = "<!---->$cvalue<!---->";
} elsif( $ctext ) {
foreach( split( /\n/, $ctext ) ) {
if( /$cmd[1]/ ) {
$src = $_;
last;
}
}
}
if( $cmd[0] eq "select" || $cmd[0] eq "radio") {
$catname = $cmd[1];
$scatname = $catname;
#$scatname =~ s/[^a-zA-Z0-9]//g;
my $size = $cmd[2];
for( $i = 3; $i < $len; $i++ ) {
my $value = $cmd[$i];
my $svalue = $value;
$svalue =~ s/[^a-zA-Z0-9]//g;
if( $src =~ /$value/ ) {
$catvalue = "$svalue";
}
}
} elsif( $cmd[0] eq "checkbox" ) {
$catname = $cmd[1];
$scatname = $catname;
#$scatname =~ s/[^a-zA-Z0-9]//g;
if( $cmd[2] eq "true" || $cmd[2] eq "1" ) {
$i = $len - 4;
$catmodifier = 1;
}
$itemsPerLine = $cmd[3];
for( $i = 4; $i < $len; $i++ ) {
my $value = $cmd[$i];
my $svalue = $value;
$svalue =~ s/[^a-zA-Z0-9]//g;
if( $src =~ /$value[^a-zA-Z0-9\.]/ ) {
$catvalue .= ", " if( $catvalue );
$catvalue .= $svalue;
}
}
} elsif( $cmd[0] eq "text" ) {
$catname = $cmd[1];
$scatname = $catname;
#$scatname =~ s/[^a-zA-Z0-9]//g;
$src =~ /<!---->(.*)<!---->/;
if( $1 ) {
$src = $1;
} else {
$src = "";
}
$catvalue = $src;
}
return ( $catname, $catmodifier, $catvalue )
}
# ============================
# load old style category table
sub upgradeCategoryTable
{
my( $web, $text, @meta ) = @_;
my $icat = &TWiki::Store::readTemplate( "twikicatitems" );
if( $icat ) {
my @items = ();
# extract category section and build category form elements
my( $before, $ctext, $after) = split( /<!--TWikiCat-->/, $text);
# cut TWikiCat part
$text = $before;
if( ! $ctext ) { $ctext = ""; }
if( $after ) {
$text .= $after;
}
my $ttext = "";
foreach( split( /\n/, $icat ) ) {
my( $catname, $catmod, $catvalue ) = upgradeCategoryItem( $_, $ctext );
TWiki::writeDebug( "Classification: name, mod, value: $catname, $catmod, $catvalue" );
if( $catname && $catname ne "UseCategory" ) {
push @items, ( [$catname, $catmod, $catvalue] );
}
}
my @formTemplates = split( /,\s*/, TWiki::Prefs::getPreferencesValue( "WEBFORMS", "$web" ) );
# FIXME - deal with none
my $defaultFormTemplate = $formTemplates[0];
my @fieldsInfo = getFormDef( $web, $defaultFormTemplate );
my @args = ( name => $defaultFormTemplate );
@meta = &TWiki::Store::metaUpdate( "FORM", \@args, "", @meta );
my $order = 0; # Used to ensure order of categories
foreach my $catInfop ( @fieldsInfo ) {
my @catInfo = @$catInfop;
my $fieldName = shift @catInfo;
my $title = shift @catInfo;
my $value = "";
foreach my $oldCatP ( @items ) {
my @oldCat = @$oldCatP;
if( _cleanField( $oldCat[0] ) eq $fieldName ) {
$value = $oldCat[2];
last;
}
}
my @args = ( "order" => sprintf( "%02d", $order ),
"name" => $fieldName,
"title" => $title,
"value" => $value );
@meta = &TWiki::Store::metaUpdate( "FIELD", \@args, "name", @meta);
$order++;
}
}
return( $text, @meta );
}
1;
|