richter at apache
Nov 12, 2006, 8:39 PM
Post #1 of 1
(848 views)
Permalink
|
|
svn commit: r474139 - in /perl/embperl/trunk/Embperl: Form.pm Form/Control.pm Form/Control/checkbox.pm
|
|
Author: richter
Date: Sun Nov 12 20:39:49 2006
New Revision: 474139
URL: http://svn.apache.org/viewvc?view=rev&rev=474139
Log:
EMbperl::Form: readd lost changes from last commit
Modified:
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Control.pm
perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
Modified: perl/embperl/trunk/Embperl/Form.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?view=diff&rev=474139&r1=474138&r2=474139
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Sun Nov 12 20:39:49 2006
@@ -1,807 +1,866 @@
-
-###################################################################################
-#
-# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-#
-# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
-# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id$
-#
-###################################################################################
-
-
-package Embperl::Form ;
-
-use strict ;
-
-use lib qw{..} ;
-
-use Embperl ;
-use Embperl::Form::Control ;
-use Embperl::Form::Validate ;
-use Embperl::Form::Control::blank ;
-
-use Embperl::Inline ;
-
-use Data::Dumper ;
-
-our %forms ;
-our $formno = 1;
-our %CLEANUP = ('forms' => 0, 'formno' => 0) ;
-
-# ---------------------------------------------------------------------------
-#
-# new - create a new form
-#
-
-
-sub new
-
- {
- my ($class, $controls, $options, $id, $validate_rules, $parentid) = @_ ;
-
- my $toplevel = $validate_rules?0:1 ;
- $id ||= 'topdiv' ;
- $options ||= {} ;
-
- my $self = ref $class?$class:{} ;
-
- $self -> {controls} = $controls ;
- $self -> {id} = $id ;
- $self -> {formno} = $formno++ ;
- $self -> {parentid} = $parentid ;
- $self -> {formname} = $options -> {formname} || 'topform' ;
- $self -> {bottom_code} = [] ;
- $self -> {validate_rules} = [] ;
- $self -> {toplevel} = $toplevel ;
-
- bless $self, $class if (!ref $class);
-
- $forms{$self->{formno}} = $self ;
- if (!$validate_rules)
- {
- $validate_rules = $self -> {validate_rules} = [] ;
- }
-
- $self -> new_controls ($controls, $options, undef, $id, $validate_rules, $options -> {masks}, $options -> {defaults}) ;
-
- $self -> {noframe} = 1 if ($controls && @$controls > 0 &&
- $controls -> [0] -> noframe) ;
-
-
- if ($toplevel)
- {
- my $epf = $self -> {validate} = Embperl::Form::Validate -> new ($validate_rules, $self -> {formname}) if ($self -> {validate_rules}) ;
- $self -> add_code_at_bottom ($epf -> get_script_code) ;
- $self -> {fields2empty} = [] ;
- }
- else
- {
- $self -> {fields2empty} = $self -> parent_form -> {fields2empty} ;
- }
-
- return $self ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# DESTROY
-#
-
-sub DESTROY
- {
- my ($self) = @_ ;
- delete $forms{$self->{formno}} ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# get_control_packages
-#
-# returns an array ref with packges where to search for controls
-#
-
-sub get_control_packages
- {
- my ($self) = @_ ;
-
- return $self -> {control_packages} || ['Embperl::Form::Control'] ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# new_controls - transform elements to control objects
-#
-
-
-sub new_controls
-
- {
- my ($self, $controls, $options, $id, $formid, $validate_rules, $masks, $defaults) = @_ ;
-
- my $n = 0 ;
- my $packages = $self -> get_control_packages ;
-
- foreach my $control (@$controls)
- {
- my $name = $control -> {name} ;
- $control -> {type} =~ s/sf_select.+/select/ ;
- $control -> {parentid} = $id if ($id) ;
- $control -> {id} ||= "$control->{name}-$n" ;
- $control -> {formid} = $formid ;
- $control -> {formno} = $self -> {formno} ;
-
- my $type = $control -> {type} ;
- my $default = $defaults -> {$name} || $defaults -> {"*$type"} || $defaults -> {'*'};
- my $mask = $masks -> {$name} || $masks -> {"*$type"} || $masks -> {'*'};
- if ($mask)
- {
- foreach (keys %$mask)
- {
- $control -> {$_} = $mask -> {$_} ;
- }
- }
- if ($default)
- {
- foreach (keys %$default)
- {
- $control -> {$_} = $default -> {$_} if (!exists $control -> {$_}) ;
- }
- }
-
-
- if (ref $control eq 'HASH')
- {
- my $ctlmod ;
- my $type = $control -> {type} || ($control -> {name}?'input':'blank') ;
- if ($type =~ /::/)
- {
- if (!defined (&{"$type\:\:new"}))
- {
- eval "require $type" ;
- warn $@ if ($@) ;
- }
- $type -> new ($control) ;
- $ctlmod = $type ;
- }
- else
- {
- foreach my $package (@$packages)
- {
- my $mod = "$package\:\:$type" ;
- if ($mod -> can('new'))
- {
- $mod -> new ($control) ;
- $ctlmod = $mod ;
- last ;
- }
- }
- if (!$ctlmod)
- {
- foreach my $package (@$packages)
- {
- my $mod = "$package\:\:$type" ;
- eval "require $mod" ;
- warn $@ if ($@) ;
- if ($mod -> can('new'))
- {
- $mod -> new ($control) ;
- $ctlmod = $mod ;
- last ;
- }
- }
- }
- }
- die "No Module found for type = $type, searched: @$packages" if (!$ctlmod) ;
- }
-
- next if ($control -> is_disabled) ;
- push @{$validate_rules}, $control -> get_validate_rules ;
- if ($control -> {sublines})
- {
- my $i = 0 ;
- my $name = $control -> {name} ;
- foreach my $subcontrols (@{$control -> {sublines}})
- {
- next if (!$subcontrols) ;
- $self -> new_controls ($subcontrols, $options, "$name-$i", $formid, $validate_rules, $masks, $defaults) ;
- $i++ ;
- }
- }
- if ($control -> {subforms})
- {
- my @obj ;
- my @ids ;
- my $i = 1 ;
-
- foreach my $subcontrols (@{$control -> {subforms}})
- {
- next if (!$subcontrols) ;
- my $id = "$control->{name}-$i" ;
- my $class = ref $self ;
- my $subform = $class -> new ($subcontrols, $options, $id, $validate_rules, $self -> {id}) ;
- push @ids, $id ;
- push @obj, $subform ;
- $i++ ;
- }
- $control -> {subobjects} = \@obj ;
- $control -> {subids} = \@ids ;
- }
- $n++ ;
- }
- }
-
-# ---------------------------------------------------------------------------
-#
-# parent_form - return parent form object if any
-#
-
-sub parent_form
- {
- my ($self) = @_ ;
-
- return $Embperl::Form::forms{$self -> {parentid}} ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# add_code_at_bottom - add js code at the bottom of the page
-#
-
-sub add_code_at_bottom
-
- {
- my ($self, $code) = @_ ;
-
- push @{$self->{bottom_code}}, $code ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# layout - build the layout of the form
-#
-
-sub layout
-
- {
- my ($self, $controls) = @_ ;
-
- $controls ||= $self -> {controls} ;
-
- my $x = 0 ;
- my $max_x = 100 ;
- my $line = [] ;
- my @lines ;
- my $max_num = 0 ;
- my $num = 0 ;
- foreach my $control (@$controls)
- {
- next if ($control -> is_disabled) ;
- my $width = $control -> {width_percent} || int($max_x / ($control -> {width} || 2)) ;
- if ($x + $width > $max_x || $control -> {newline} > 0 || (($control -> {sublines} || $control -> {subobjects}) && @$line))
- { # new line
- if ($x < $max_x)
- {
- push @$line, Embperl::Form::Control::blank -> new (
- {width_percent => $max_x - $x }) ;
- }
- push @lines, $line ;
- $line = [] ;
- $x = 0 ;
- $num = 0 ;
- }
- push @$line, $control ;
- $control -> {width_percent} = $width ;
- $control -> {x_percent} = $x ;
- $x += $width ;
- $num++ ;
- $max_num = $num if ($num > $max_num) ;
-
- if ($control -> {subobjects} || $control -> {sublines} || $control -> {newline} < 0)
- { # new line
- if ($x < $max_x)
- {
- push @$line, Embperl::Form::Control::blank -> new (
- {width_percent => $max_x - $x }) ;
- }
- push @lines, $line ;
- $line = [] ;
- $x = 0 ;
- $num = 0 ;
- }
-
- if ($control -> {sublines})
- {
- foreach my $subcontrols (@{$control -> {sublines}})
- {
- next if (!$subcontrols) ;
- my $sublines = $self -> layout ($subcontrols) ;
- push @lines, @$sublines ;
- }
- }
- if ($control -> {subobjects})
- {
- my @obj ;
- foreach my $subobj (@{$control -> {subobjects}})
- {
- next if (!$subobj) ;
- $subobj -> layout ;
- }
- }
- }
-
- push @lines, $line if (@$line);
- $self -> {max_num} = $max_num ;
- return $self -> {layout} = \@lines ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# show_controls - output the form control area
-#
-
-sub show_controls
-
- {
- my ($self, $data, $activeid) = @_ ;
-
- my $lines = $self -> {layout} ;
- my %n ;
- my $activesubid ;
-
- $self -> show_controls_begin ($activeid) ;
- my $lineno = 0 ;
- foreach my $line (@$lines)
- {
- my $lineid = @$line && $line->[0]{parentid}?"$line->[0]{parentid}":'id' ;
- $n{$lineid} ||= 10 ;
-
- $self -> show_line_begin ($lineno, "$lineid-$n{$lineid}", $activesubid);
- foreach my $control (@$line)
- {
- my $newactivesubid = $control -> get_active_id ;
- $control -> show ($data);
- $activesubid = $newactivesubid if ($newactivesubid) ;
- if ($control -> {subobjects})
- {
- my @obj ;
- $control -> show_sub_begin ;
- foreach my $subobj (@{$control -> {subobjects}})
- {
- next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}}) ;
- $subobj -> show ($data, $activesubid) ;
- }
- $control -> show_sub_end ;
- }
- }
- $self -> show_line_end ($lineno);
- $lineno++ ;
- $n{$lineid}++ ;
- }
- $self -> show_controls_end ;
-
- return ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# show - output the form
-#
-
-sub show
-
- {
- my ($self, $data, $activeid) = @_ ;
-
- $self -> show_form_begin if ($self -> {toplevel});
- $self -> show_controls ($data, $activeid) ;
- $self -> show_form_end if ($self -> {toplevel});
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# validate - validate the form input
-#
-
-sub validate
-
- {
-
- }
-
-
-#------------------------------------------------------------------------------------------
-#
-# add_tabs
-#
-# fügt ein tab elsement mit subforms zu einem Formular hinzu
-#
-# in $subform array mit hashs
-# text => <anzeige text>
-# fn => Dateiname
-# fields => Felddefinitionen (alternativ zu fn)
-#
-
-sub add_tabs
-
- {
- my ($self, $subforms, $args) = @_ ;
- my @forms ;
- my @values ;
- my @options ;
- my @grids;
- $args ||= {} ;
-
- foreach my $file (@$subforms)
- {
- my $fn = $file -> {fn} ;
- my $subfields = $file -> {fields} ;
-
- push @options, $file -> {text};
- if ($fn)
- {
- my $obj = Execute ({object => "./$fn"} ) ;
- #$subfields = eval {$obj -> fields ($r, {%$file, %$args}) || undef};
- }
- push @forms, $subfields;
- push @grids, $file -> {grid};
- push @values, $file -> {value} ||= scalar(@forms);
- }
-
- return {
- section => 'cSectionText',
- name => '__auswahl',
- type => 'tabs',
- values => \@values,
- grids => \@grids,
- options => \@options,
- subforms=> \@forms,
- width => 1,
- },
- }
-
-#------------------------------------------------------------------------------------------
-#
-# add_line
-#
-# adds the given controls into one line
-#
-#
-
-sub add_line
-
- {
- my ($self, $controls, $cnt) = @_ ;
-
- $cnt ||= @$controls ;
- foreach my $control (@$controls)
- {
- $control -> {width} = $cnt ;
- }
-
- return @$controls ;
- }
-
-#------------------------------------------------------------------------------------------
-#
-# add_sublines
-#
-# fügt ein tab elsement mit subforms zu einem Formular hinzu
-#
-# in $subform array mit hashs
-# text => <anzeige text>
-# fn => Dateiname
-# fields => Felddefinitionen (alternativ zu fn)
-#
-
-
-sub add_sublines
- {
- my ($self, $object_data, $subforms, $type) = @_;
-
- my $name = $object_data->{name};
- my $text = $object_data->{text};
- my $width = $object_data->{width};
- my $section = $object_data->{section};
-
- $text ||= $name;
-
- my @forms ;
- my @values ;
- my @options ;
-
- foreach my $file (@$subforms)
- {
- my $fn = $file -> {fn} ;
- my $subfields = $file -> {fields} ;
- if ($fn)
- {
- my $obj = Execute ({object => "./$fn"} ) ;
- #$subfields = eval {$obj -> fields ($r,$file) || undef};
- }
- push @forms, $subfields || [];
- push @values, $file->{value} || $file->{name};
- push @options, $file -> {text} || $file->{value} || $file->{name};
- }
-
- return { section => $section , width => $width, name => $name , text => $text, type => $type || 'select',
- values => \@values, options => \@options, sublines => \@forms,
- class => $object_data->{class}, controlclass => $object_data->{controlclass}};
-
- }
-
-#------------------------------------------------------------------------------------------
-#
-# fields_add_checkbox_subform
-#
-# fügt ein checkbox Element mit Subforms hinzu
-#
-# in $subform array mit hashs
-# text => <anzeige text>
-# name => <name des Attributes>
-# value => <Wert der checkbox>
-# fn => Dateiname
-# fields => Felddefinitionen (alternativ zu fn)
-#
-
-sub add_checkbox_subform
- {
- my ($self, $subform, $args) = @_ ;
- $args ||= {} ;
-
- my $name = $subform->{name};
- my $text = $subform->{text};
- my $value = $subform->{value} || 1 ;
-
- my $width = $subform->{width};
- my $section;
-
- if(! $subform->{nosection})
- {
- $section = $subform->{section};
- $section ||= 1;
- }
-
- $name ||= "__$value";
- $width ||= 1;
-
- my $subfield;
- my $fn;
- if($subfield = $subform->{fields})
- {
- # .... ok
- }
- elsif($fn = $subform->{fn})
- {
- my $obj = Execute ({object => "./$fn"} ) ;
- #$subfield = [.eval {$obj -> fields ($r, { %$file, %$args} ) || undef}];
- }
-
-
- return {type => 'checkbox' , section => $section, width => $width, name => $name, text => $text, value => $value, sublines => $subfield}
-
- }
-
-
-1;
-
-
-__EMBPERL__
-
-[$syntax EmbperlBlocks $]
-
-[.# ---------------------------------------------------------------------------
-#
-# show_form_begin - output begin of form
-#]
-
-[$ sub show_form_begin ($self) $]
-<script language="javascript">var doValidate = 1 ;</script>
-<script src="/js/EmbperlForm.js"></script>
-<script src="/js/TableCtrl.js"></script>
-
-<form id="[+ $self->{formname} +]" name="[+ $self->{formname} +]" method="post" action="[+ $self->{actionurl}+]"
-[$ if ($self -> {on_submit_function}) $]
-onSubmit="s=[+ $self->{on_submit_function} +];if (s) { v=doValidate; doValidate=1; return ((!v) || epform_validate_[+ $self->{formname} +]()); } else { return false; }"
-[$else$]
-onSubmit="v=doValidate; doValidate=1; return ( (!v) || epform_validate_[+ $self->{formname}+]());"
-[$endif$]
->
-[$endsub$]
-
-[.# ---------------------------------------------------------------------------
-#
-# show_form_end - output end of form
-#]
-
-[$ sub show_form_end $]
-</form>
-[$endsub$]
-
-[. ---------------------------------------------------------------------------
-#
-# show_controls_begin - output begin of form controls area
-#]
-
-[.$ sub show_controls_begin ($self, $activeid)
-
-my $parent = $self -> parent_form ;
-my $class = $parent -> {noframe}?'cTableDivU':'cTableDiv' ;
-$]
-<div id="[+ $self->{id} +]"
-[$if ($activeid && $self->{id} ne $activeid) $] style="display: none" [$endif$]
->
-[$if (!$self -> {noframe}) $]<table class="[+ $class +]"><tr><td class="cTabTD"> [$endif$]
-<table class="cBase cTable">
-[$endsub$]
-
-[.# ---------------------------------------------------------------------------
-#
-# show_controls_end - output end of form controls area
-#]
-
-[$sub show_controls_end ($self) $]
-</table>
-[$ if (!$self -> {noframe}) $]</td></tr></table> [$endif$]
-</div>
-
-[$ if (@{$self->{bottom_code}}) $]
-<script language="javascript">
-[.+ do { local $escmode = 0; join ("\n", @{$self->{bottom_code}}) } +]
-</script>
-[$endif$]
-[$ if ($self -> {toplevel} && @{$self -> {fields2empty}}) $]
-<input type="hidden" name="-fields2empty" value="[+ join (' ', @{$self -> {fields2empty}}) +]">
-[$endif$]
-[$endsub$]
-
-[.# ---------------------------------------------------------------------------
-#
-# show_line_begin - output begin of line
-#]
-
-[.$ sub show_line_begin ($self, $lineno, $id, $activeid)
-
- $id =~ /^(.+)-(\d+?)-(\d+?)$/ ;
- my $baseid = $1 ;
- my $baseidn = $2 ;
- $activeid =~ /^(.+)-(\d+?)$/ ;
- my $baseaid = $1 ;
- my $baseaidn = $2 ;
-
- my $class = $lineno == 0?'cTableRow1':'cTableRow' ;
-$]
- <tr class="[+ $class +]"
- [$if $id $] id="[+ $id +]"[$endif$]
- [$if ($baseid eq $baseaid && $baseidn != $baseaidn) $] style="display: none"[$endif$]
- >
-[$endsub$]
-
-[.# ---------------------------------------------------------------------------
-#
-# show_line_end - output end of line
-#]
-
-[$ sub show_line_end $]
- </tr>
-[$endsub$]
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Embperl::Form - Embperl Form class
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=head2 new ($controls, $options)
-
-=over 4
-
-=item * $controls
-
-Array ref with controls which should be displayed
-inside the form. Each control needs either to be a
-hashref with all parameters for the control or
-a control object.
-
-If hash refs are given it's necessary to specify
-the C<type> parameter, to let Embperl::Form
-know which control to create.
-
-See Embperl::Form::Control and Embperl::Form::Control::*
-for a list of available parameters.
-
-=item * $options
-
-Hash ref which can take the following parameters:
-
-=over 4
-
-=item * formname
-
-Will be used as name and id attribute of the form. If you have more
-then one form on a page it's necessary to have different form names
-to make form validation work correctly.
-
-=item * masks
-
-Contains a hash ref which can specify a set of masks
-for the controls. A mask is a set of parameter which
-overwrite the setting of a control. You can specify
-a mask for a control name (key is name), for a control
-type (key is *type) or for all controls (key is *).
-
-Example:
-
- {
- 'info' => { readonly => 1},
- '*textarea' => { cols => 80 },
- '*' => { labelclass => 'myclass', labelnowrap => 1}
- }
-
-This will force the control with the name C<info> to be readonly, it
-will force all C<textarea> controls to have 80 columns and
-it will force the label of all controls to have a class of myclass
-and not to wrap the text.
-
-=item * defaults
-
-Contains a hash ref which can specify a set of defaults
-for the controls. You can specify
-a default for a control name (key is name), for a control
-type (key is *type) or for all controls (key is *).
-
-Example:
-
- {
- 'info' => { readonly => 1},
- '*textarea' => { cols => 80 },
- '*' => { labelclass => 'myclass', labelnowrap => 1}
- }
-
-This will make the control with the name C<info> to default to be readonly, it
-will deafult all C<textarea> controls to have 80 columns and
-it will set the default class for the labels of all controls to
-myclass and not to wrap the text.
-
-=back
-
-=back
-
-=head2 layout
-
-=head2 show
-
-
-=head1 AUTHOR
-
-G. Richter (richter[at]dev.ecos.de)
-
-=head1 SEE ALSO
-
-perl(1), Embperl, Embperl::Form::Control
-
-
-
-
-
-
-
+
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the Perl README file.
+#
+# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+#
+# $Id$
+#
+###################################################################################
+
+
+package Embperl::Form ;
+
+use strict ;
+
+use lib qw{..} ;
+
+use Embperl ;
+use Embperl::Form::Control ;
+use Embperl::Form::Validate ;
+use Embperl::Form::Control::blank ;
+
+use Embperl::Inline ;
+
+use Data::Dumper ;
+
+our %forms ;
+our %CLEANUP = ('forms' => 0) ;
+
+# ---------------------------------------------------------------------------
+#
+# new - create a new form
+#
+
+
+sub new
+
+ {
+ my ($class, $controls, $options, $id, $validate_rules, $parentptr) = @_ ;
+
+ my $toplevel = $validate_rules?0:1 ;
+ $id ||= 'topdiv' ;
+ $options ||= {} ;
+
+ my $self = ref $class?$class:{} ;
+
+ $self -> {controls} = $controls ;
+ $self -> {id} = $id ;
+ $self -> {parentptr} = $parentptr ;
+ $self -> {formname} = $options -> {formname} || 'topform' ;
+ $self -> {bottom_code} = [] ;
+ $self -> {validate_rules} = [] ;
+ $self -> {toplevel} = $toplevel ;
+ $self -> {valign} = $options -> {valign} || 'top' ;
+
+ bless $self, $class if (!ref $class);
+
+ $Embperl::FormData::forms{"$self"} = $self ;
+ if (!$validate_rules)
+ {
+ $validate_rules = $self -> {validate_rules} = [] ;
+ }
+
+ $self -> new_controls ($controls, $options, undef, $id, $validate_rules, $options -> {masks}, $options -> {defaults}) ;
+
+ $self -> {noframe} = 1 if ($controls && @$controls > 0 &&
+ $controls -> [0] -> noframe) ;
+
+
+ if ($toplevel)
+ {
+ my $epf = $self -> {validate} = Embperl::Form::Validate -> new ($validate_rules, $self -> {formname}) if ($self -> {validate_rules}) ;
+ $self -> add_code_at_bottom ($epf -> get_script_code) ;
+ $self -> {fields2empty} = [] ;
+ }
+ else
+ {
+ $self -> {fields2empty} = $self -> parent_form -> {fields2empty} ;
+ }
+
+ return $self ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# DESTROY
+#
+
+sub DESTROY
+ {
+ my ($self) = @_ ;
+
+ delete $Embperl::FormData::forms{"$self"} ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_control_packages
+#
+# returns an array ref with packges where to search for control classes
+#
+
+sub get_control_packages
+ {
+ my ($self) = @_ ;
+
+ return $self -> {control_packages} || ['Embperl::Form::Control'] ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_datasrc_packages
+#
+# returns an array ref with packges where to search for data source classes
+#
+
+sub get_datasrc_packages
+ {
+ my ($self) = @_ ;
+
+ return $self -> {datasrc_packages} || ['Embperl::Form::DataSource'] ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# new_object - load a control or datasrc class and create a new object of
+# this class
+#
+# in $packages arrayref of packages to search the class
+# $name name of the class. Either a full package name or
+# only the last part of the package. In the later
+# @$packages are searched for this class
+# ret reference to the object
+#
+
+sub new_object
+
+ {
+ my ($self, $packages, $name, $args) = @_ ;
+
+ my $ctlmod ;
+ my $obj ;
+
+ $args ||= {} ;
+
+ if ($name =~ /::/)
+ {
+ if (!defined (&{"$name\:\:new"}))
+ {
+ eval "require $name" ;
+ warn $@ if ($@) ;
+ }
+ $obj = $name -> new ($args) ;
+ $ctlmod = $name ;
+ }
+ else
+ {
+ foreach my $package (@$packages)
+ {
+ my $mod = "$package\:\:$name" ;
+ if ($mod -> can('new'))
+ {
+ $obj = $mod -> new ($args) ;
+ $ctlmod = $mod ;
+ last ;
+ }
+ }
+ if (!$ctlmod)
+ {
+ foreach my $package (@$packages)
+ {
+ my $mod = "$package\:\:$name" ;
+ eval "require $mod" ;
+ warn $@ if ($@) ;
+ if ($mod -> can('new'))
+ {
+ $obj = $mod -> new ($args) ;
+ $ctlmod = $mod ;
+ last ;
+ }
+ }
+ }
+ }
+ die "No Module found for type = $name, searched: @$packages" if (!$ctlmod || !$obj) ;
+
+ return $obj ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# new_controls - transform elements to control objects
+#
+
+
+sub new_controls
+
+ {
+ my ($self, $controls, $options, $id, $formid, $validate_rules, $masks, $defaults) = @_ ;
+
+ my $n = 0 ;
+ my $packages = $self -> get_control_packages ;
+
+ foreach my $control (@$controls)
+ {
+ die "control definition must be a hashref or an object, is '$control' " if (!ref $control || ref $control eq 'ARRAY');
+
+ my $name = $control -> {name} ;
+ $control -> {type} =~ s/sf_select.+/select/ ;
+ $control -> {parentid} = $id if ($id) ;
+ $control -> {id} ||= "$control->{name}-$n" ;
+ $control -> {formid} = $formid ;
+ $control -> {formptr} = "$self" ;
+
+ my $type = $control -> {type} ;
+ my $default = $defaults -> {$name} || $defaults -> {"*$type"} || $defaults -> {'*'};
+ my $mask = $masks -> {$name} || $masks -> {"*$type"} || $masks -> {'*'};
+ if ($mask)
+ {
+ foreach (keys %$mask)
+ {
+ $control -> {$_} = $mask -> {$_} ;
+ }
+ }
+ if ($default)
+ {
+ foreach (keys %$default)
+ {
+ $control -> {$_} = $default -> {$_} if (!exists $control -> {$_}) ;
+ }
+ }
+
+
+ if (ref $control eq 'HASH')
+ {
+ my $type = $control -> {type} || ($control -> {name}?'input':'blank') ;
+ $control = $self -> new_object ($packages, $type, $control) ;
+ }
+
+ next if ($control -> is_disabled) ;
+ push @{$validate_rules}, $control -> get_validate_rules ;
+ if ($control -> {sublines})
+ {
+ my $i = 0 ;
+ my $name = $control -> {name} ;
+ foreach my $subcontrols (@{$control -> {sublines}})
+ {
+ next if (!$subcontrols) ;
+ $self -> new_controls ($subcontrols, $options, "$name-$i", $formid, $validate_rules, $masks, $defaults) ;
+ $i++ ;
+ }
+ }
+ if ($control -> {subforms})
+ {
+ my @obj ;
+ my @ids ;
+ my $i = 1 ;
+
+ foreach my $subcontrols (@{$control -> {subforms}})
+ {
+ next if (!$subcontrols) ;
+ my $id = "$control->{name}-$i" ;
+ my $class = ref $self ;
+ my $subform = $class -> new ($subcontrols, $options, $id, $validate_rules, "$self") ;
+ push @ids, $id ;
+ push @obj, $subform ;
+ $i++ ;
+ }
+ $control -> {subobjects} = \@obj ;
+ $control -> {subids} = \@ids ;
+ }
+ $n++ ;
+ }
+ }
+
+# ---------------------------------------------------------------------------
+#
+# parent_form - return parent form object if any
+#
+
+sub parent_form
+ {
+ my ($self) = @_ ;
+
+ return $Embperl::FormData::forms{$self -> {parentptr}} ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# add_code_at_bottom - add js code at the bottom of the page
+#
+
+sub add_code_at_bottom
+
+ {
+ my ($self, $code) = @_ ;
+
+ push @{$self->{bottom_code}}, $code ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# layout - build the layout of the form
+#
+
+sub layout
+
+ {
+ my ($self, $controls) = @_ ;
+
+ $controls ||= $self -> {controls} ;
+
+ my $x = 0 ;
+ my $max_x = 100 ;
+ my $line = [] ;
+ my @lines ;
+ my $max_num = 0 ;
+ my $num = 0 ;
+ foreach my $control (@$controls)
+ {
+ next if ($control -> is_disabled) ;
+ my $width = $control -> {width_percent} || int($max_x / ($control -> {width} || 2)) ;
+ if ($x + $width > $max_x || $control -> {newline} > 0 || (($control -> {sublines} || $control -> {subobjects}) && @$line))
+ { # new line
+ if ($x < $max_x)
+ {
+ push @$line, Embperl::Form::Control::blank -> new (
+ {width_percent => $max_x - $x }) ;
+ }
+ push @lines, $line ;
+ $line = [] ;
+ $x = 0 ;
+ $num = 0 ;
+ }
+ push @$line, $control ;
+ $control -> {width_percent} = $width ;
+ $control -> {x_percent} = $x ;
+ $x += $width ;
+ $num++ ;
+ $max_num = $num if ($num > $max_num) ;
+
+ if ($control -> {subobjects} || $control -> {sublines} || $control -> {newline} < 0)
+ { # new line
+ if ($x < $max_x)
+ {
+ push @$line, Embperl::Form::Control::blank -> new (
+ {width_percent => $max_x - $x }) ;
+ }
+ push @lines, $line ;
+ $line = [] ;
+ $x = 0 ;
+ $num = 0 ;
+ }
+
+ if ($control -> {sublines})
+ {
+ foreach my $subcontrols (@{$control -> {sublines}})
+ {
+ next if (!$subcontrols) ;
+ my $sublines = $self -> layout ($subcontrols) ;
+ push @lines, @$sublines ;
+ }
+ }
+ if ($control -> {subobjects})
+ {
+ my @obj ;
+ foreach my $subobj (@{$control -> {subobjects}})
+ {
+ next if (!$subobj) ;
+ $subobj -> layout ;
+ }
+ }
+ }
+
+ push @lines, $line if (@$line);
+ $self -> {max_num} = $max_num ;
+ return $self -> {layout} = \@lines ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# show_controls - output the form control area
+#
+
+sub show_controls
+
+ {
+ my ($self, $req, $activeid) = @_ ;
+
+ my $lines = $self -> {layout} ;
+ my %n ;
+ my $activesubid ;
+
+ $self -> show_controls_begin ($req, $activeid) ;
+ my $lineno = 0 ;
+ foreach my $line (@$lines)
+ {
+ my $lineid = @$line && $line->[0]{parentid}?"$line->[0]{parentid}":'id' ;
+ $n{$lineid} ||= 10 ;
+
+ $self -> show_line_begin ($req, $lineno, "$lineid-$n{$lineid}", $activesubid);
+ foreach my $control (@$line)
+ {
+ my $newactivesubid = $control -> get_active_id ($req) ;
+ $control -> show ($req);
+ $activesubid = $newactivesubid if ($newactivesubid) ;
+ if ($control -> {subobjects})
+ {
+ my @obj ;
+ $control -> show_sub_begin ($req) ;
+ foreach my $subobj (@{$control -> {subobjects}})
+ {
+ next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}}) ;
+ $subobj -> show ($req, $activesubid) ;
+ }
+ $control -> show_sub_end ($req) ;
+ }
+ }
+ $self -> show_line_end ($req, $lineno);
+ $lineno++ ;
+ $n{$lineid}++ ;
+ }
+ $self -> show_controls_end ($req) ;
+
+ return ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# show - output the form
+#
+
+sub show
+
+ {
+ my ($self, $req, $activeid) = @_ ;
+
+ $self -> init_data ($req) if ($self -> {toplevel});
+ #$self -> validate ($req) if ($self -> {toplevel});
+ $self -> show_form_begin ($req) if ($self -> {toplevel});
+ $self -> show_controls ($req, $activeid) ;
+ $self -> show_form_end ($req) if ($self -> {toplevel});
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# init_data -
+#
+
+sub init_data
+
+ {
+
+ }
+
+# ---------------------------------------------------------------------------
+#
+# validate - validate the form input
+#
+
+sub validate
+
+ {
+
+ }
+
+
+#------------------------------------------------------------------------------------------
+#
+# add_tabs
+#
+# fügt ein tab elsement mit subforms zu einem Formular hinzu
+#
+# in $subform array mit hashs
+# text => <anzeige text>
+# fn => Dateiname
+# fields => Felddefinitionen (alternativ zu fn)
+#
+
+sub add_tabs
+
+ {
+ my ($self, $subforms, $args) = @_ ;
+ my @forms ;
+ my @values ;
+ my @options ;
+ my @grids;
+ $args ||= {} ;
+
+ foreach my $file (@$subforms)
+ {
+ my $fn = $file -> {fn} ;
+ my $subfields = $file -> {fields} ;
+
+ push @options, $file -> {text};
+ if ($fn)
+ {
+ my $obj = Execute ({object => "./$fn"} ) ;
+ #$subfields = eval {$obj -> fields ($r, {%$file, %$args}) || undef};
+ }
+ push @forms, $subfields;
+ push @grids, $file -> {grid};
+ push @values, $file -> {value} ||= scalar(@forms);
+ }
+
+ return {
+ section => 'cSectionText',
+ name => '__auswahl',
+ type => 'tabs',
+ values => \@values,
+ grids => \@grids,
+ options => \@options,
+ subforms=> \@forms,
+ width => 1,
+ },
+ }
+
+#------------------------------------------------------------------------------------------
+#
+# add_line
+#
+# adds the given controls into one line
+#
+#
+
+sub add_line
+
+ {
+ my ($self, $controls, $cnt) = @_ ;
+
+ $cnt ||= @$controls ;
+ foreach my $control (@$controls)
+ {
+ $control -> {width} = $cnt ;
+ }
+
+ return @$controls ;
+ }
+
+#------------------------------------------------------------------------------------------
+#
+# add_sublines
+#
+# fügt ein tab elsement mit subforms zu einem Formular hinzu
+#
+# in $subform array mit hashs
+# text => <anzeige text>
+# fn => Dateiname
+# fields => Felddefinitionen (alternativ zu fn)
+#
+
+
+sub add_sublines
+ {
+ my ($self, $object_data, $subforms, $type) = @_;
+
+ my $name = $object_data->{name};
+ my $text = $object_data->{text};
+ my $width = $object_data->{width};
+ my $section = $object_data->{section};
+
+ $text ||= $name;
+
+ my @forms ;
+ my @values ;
+ my @options ;
+
+ foreach my $file (@$subforms)
+ {
+ my $fn = $file -> {fn} ;
+ my $subfields = $file -> {fields} ;
+ if ($fn)
+ {
+ my $obj = Execute ({object => "./$fn"} ) ;
+ #$subfields = eval {$obj -> fields ($r,$file) || undef};
+ }
+ push @forms, $subfields || [];
+ push @values, $file->{value} || $file->{name};
+ push @options, $file -> {text} || $file->{value} || $file->{name};
+ }
+
+ return { section => $section , width => $width, name => $name , text => $text, type => $type || 'select',
+ values => \@values, options => \@options, sublines => \@forms,
+ class => $object_data->{class}, controlclass => $object_data->{controlclass}};
+
+ }
+
+#------------------------------------------------------------------------------------------
+#
+# fields_add_checkbox_subform
+#
+# fügt ein checkbox Element mit Subforms hinzu
+#
+# in $subform array mit hashs
+# text => <anzeige text>
+# name => <name des Attributes>
+# value => <Wert der checkbox>
+# fn => Dateiname
+# fields => Felddefinitionen (alternativ zu fn)
+#
+
+sub add_checkbox_subform
+ {
+ my ($self, $subform, $args) = @_ ;
+ $args ||= {} ;
+
+ my $name = $subform->{name};
+ my $text = $subform->{text};
+ my $value = $subform->{value} || 1 ;
+
+ my $width = $subform->{width};
+ my $section;
+
+ if(! $subform->{nosection})
+ {
+ $section = $subform->{section};
+ $section ||= 1;
+ }
+
+ $name ||= "__$value";
+ $width ||= 1;
+
+ my $subfield;
+ my $fn;
+ if($subfield = $subform->{fields})
+ {
+ # .... ok
+ }
+ elsif($fn = $subform->{fn})
+ {
+ my $obj = Execute ({object => "./$fn"} ) ;
+ #$subfield = [.eval {$obj -> fields ($r, { %$file, %$args} ) || undef}];
+ }
+
+
+ return {type => 'checkbox' , section => $section, width => $width, name => $name, text => $text, value => $value, sublines => $subfield}
+
+ }
+
+
+1;
+
+
+__EMBPERL__
+
+[$syntax EmbperlBlocks $]
+
+[.# ---------------------------------------------------------------------------
+#
+# show_form_begin - output begin of form
+#]
+
+[$ sub show_form_begin ($self, $req) $]
+<script language="javascript">var doValidate = 1 ;</script>
+<script src="/js/EmbperlForm.js"></script>
+<script src="/js/TableCtrl.js"></script>
+
+<form id="[+ $self->{formname} +]" name="[+ $self->{formname} +]" method="post" action="[+ $self->{actionurl}+]"
+[$ if ($self -> {on_submit_function}) $]
+onSubmit="s=[+ $self->{on_submit_function} +];if (s) { v=doValidate; doValidate=1; return ((!v) || epform_validate_[+ $self->{formname} +]()); } else { return false; }"
+[$else$]
+onSubmit="v=doValidate; doValidate=1; return ( (!v) || epform_validate_[+ $self->{formname}+]());"
+[$endif$]
+>
+[$endsub$]
+
+[.# ---------------------------------------------------------------------------
+#
+# show_form_end - output end of form
+#]
+
+[$ sub show_form_end ($req) $]
+</form>
+[$endsub$]
+
+[. ---------------------------------------------------------------------------
+#
+# show_controls_begin - output begin of form controls area
+#]
+
+[.$ sub show_controls_begin ($self, $req, $activeid)
+
+my $parent = $self -> parent_form ;
+my $class = $parent -> {noframe}?'cTableDivU':'cTableDiv' ;
+$]
+<div id="[+ $self->{id} +]"
+[$if ($activeid && $self->{id} ne $activeid) $] style="display: none" [$endif$]
+>
+[$if (!$self -> {noframe}) $]<table class="[+ $class +]"><tr><td class="cTabTD"> [$endif$]
+<table class="cBase cTable">
+[$endsub$]
+
+[.# ---------------------------------------------------------------------------
+#
+# show_controls_end - output end of form controls area
+#]
+
+[$sub show_controls_end ($self, $req) $]
+</table>
+[$ if (!$self -> {noframe}) $]</td></tr></table> [$endif$]
+</div>
+
+[$ if (@{$self->{bottom_code}}) $]
+<script language="javascript">
+[.+ do { local $escmode = 0; join ("\n", @{$self->{bottom_code}}) } +]
+</script>
+[$endif$]
+[$ if ($self -> {toplevel} && @{$self -> {fields2empty}}) $]
+<input type="hidden" name="-fields2empty" value="[+ join (' ', @{$self -> {fields2empty}}) +]">
+[$endif$]
+[$endsub$]
+
+
+[.# ---------------------------------------------------------------------------
+#
+# show_line_begin - output begin of line
+#]
+
+[.$ sub show_line_begin ($self, $req, $lineno, $id, $activeid)
+
+ $id =~ /^(.+)-(\d+?)-(\d+?)$/ ;
+ my $baseid = $1 ;
+ my $baseidn = $2 ;
+ $activeid =~ /^(.+)-(\d+?)$/ ;
+ my $baseaid = $1 ;
+ my $baseaidn = $2 ;
+
+ my $class = $lineno == 0?'cTableRow1':'cTableRow' ;
+$]
+ <tr class="[+ $class +]" valign="[+ $self->{valign} +]"
+ [$if $id $] id="[+ $id +]"[$endif$]
+ [$if ($baseid eq $baseaid && $baseidn != $baseaidn) $] style="display: none"[$endif$]
+ >
+[$endsub$]
+
+[.# ---------------------------------------------------------------------------
+#
+# show_line_end - output end of line
+#]
+
+[$ sub show_line_end ($req) $]
+ </tr>
+[$endsub$]
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Embperl::Form - Embperl Form class
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 new ($controls, $options)
+
+=over 4
+
+=item * $controls
+
+Array ref with controls which should be displayed
+inside the form. Each control needs either to be a
+hashref with all parameters for the control or
+a control object.
+
+If hash refs are given it's necessary to specify
+the C<type> parameter, to let Embperl::Form
+know which control to create.
+
+See Embperl::Form::Control and Embperl::Form::Control::*
+for a list of available parameters.
+
+=item * $options
+
+Hash ref which can take the following parameters:
+
+=over 4
+
+=item * formname
+
+Will be used as name and id attribute of the form. If you have more
+then one form on a page it's necessary to have different form names
+to make form validation work correctly.
+
+=item * masks
+
+Contains a hash ref which can specify a set of masks
+for the controls. A mask is a set of parameter which
+overwrite the setting of a control. You can specify
+a mask for a control name (key is name), for a control
+type (key is *type) or for all controls (key is *).
+
+Example:
+
+ {
+ 'info' => { readonly => 1},
+ '*textarea' => { cols => 80 },
+ '*' => { labelclass => 'myclass', labelnowrap => 1}
+ }
+
+This will force the control with the name C<info> to be readonly, it
+will force all C<textarea> controls to have 80 columns and
+it will force the label of all controls to have a class of myclass
+and not to wrap the text.
+
+=item * defaults
+
+Contains a hash ref which can specify a set of defaults
+for the controls. You can specify
+a default for a control name (key is name), for a control
+type (key is *type) or for all controls (key is *).
+
+Example:
+
+ {
+ 'info' => { readonly => 1},
+ '*textarea' => { cols => 80 },
+ '*' => { labelclass => 'myclass', labelnowrap => 1}
+ }
+
+This will make the control with the name C<info> to default to be readonly, it
+will deafult all C<textarea> controls to have 80 columns and
+it will set the default class for the labels of all controls to
+myclass and not to wrap the text.
+
+=item * valign
+
+valign for control cells. Defaults to 'top' .
+
+=back
+
+=back
+
+=head2 layout
+
+=head2 show
+
+
+=head1 AUTHOR
+
+G. Richter (richter[at]dev.ecos.de)
+
+=head1 SEE ALSO
+
+perl(1), Embperl, Embperl::Form::Control
+
+
+
+
+
Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?view=diff&rev=474139&r1=474138&r2=474139
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Sun Nov 12 20:39:49 2006
@@ -32,16 +32,32 @@
{
my ($class, $args) = @_ ;
- bless $args, $class ;
+ my $self = { %$args } ;
+ bless $self, $class ;
- return $args ;
+ $self -> init ;
+
+ return $self ;
}
# ---------------------------------------------------------------------------
#
-# noframe - do not draw frame border if this is the only control
+# init - init the new control
#
+sub init
+
+ {
+ my ($self) = @_ ;
+
+ return $self ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# noframe - do not draw frame border if this is the only control
+#
sub noframe
@@ -54,11 +70,10 @@
# is_disabled - do not display this control at all
#
-
sub is_disabled
{
- my ($self) = @_ ;
+ my ($self, $req) = @_ ;
return $self -> {disable} ;
}
@@ -68,31 +83,28 @@
# is_readonly - could value of this control be changed ?
#
-
sub is_readonly
{
- my ($self) = @_ ;
+ my ($self, $req) = @_ ;
return $self -> {readonly} ;
}
-
-
# ---------------------------------------------------------------------------
#
-# show - output the control
+# show - output the whole control including the label
#
sub show
{
- my ($self, $data) = @_ ;
+ my ($self, $req) = @_ ;
$fdat{$self -> {name}} = $self -> {default} if ($fdat{$self -> {name}} eq '' && exists ($self -> {default})) ;
my $span = 0 ;
- $span += $self -> show_label_cell ($span);
- return $self -> show_control_cell ($span, $data) ;
+ $span += $self -> show_label_cell ($req, $span);
+ return $self -> show_control_cell ($req, $span) ;
}
# ---------------------------------------------------------------------------
@@ -118,7 +130,6 @@
return ;
}
-
# ---------------------------------------------------------------------------
#
# form - return form object
@@ -128,10 +139,9 @@
{
my ($self) = @_ ;
- return $Embperl::Form::forms{$self -> {formno}} ;
+ return $Embperl::FormData::forms{$self -> {formptr}} ;
}
-
# ---------------------------------------------------------------------------
#
# get_validate_rules - get rules for validation
@@ -139,7 +149,7 @@
sub get_validate_rules
{
- my ($self) = @_ ;
+ my ($self, $req) = @_ ;
my @local_rules ;
if ($self -> {validate})
@@ -166,7 +176,7 @@
# show_sub_begin - output begin of sub form
#]
-[.$sub show_sub_begin ($self)
+[$sub show_sub_begin ($self, $req)
my $span = $self->{width_percent} ;
$]
@@ -178,23 +188,23 @@
# show_sub_end - output end of sub form
#]
-[$sub show_sub_end ($self) $]
+[$sub show_sub_end ($self, $req) $]
</td>
[$endsub$]
[# ---------------------------------------------------------------------------
#
-# show - output the control
+# show - output the label
#]
-[$ sub show_label ($self) $][+ $self->{text} || $self->{name} +][$endsub$]
+[$ sub show_label ($self, $req) $][+ $self->{text} || $self->{name} +][$endsub$]
[# ---------------------------------------------------------------------------
#
# show_label_icon - output the icon before the label
#]
-[$sub show_label_icon ($self) $]
+[$sub show_label_icon ($self, $req) $]
[$if $self -> {sublines} $] <img src="plus.png" style="vertical-align: middle;">[$endif$]
[$if $self -> {parentid} $] <img src="vline.png" style="vertical-align: middle;">[$endif$]
[$endsub$]
@@ -204,7 +214,7 @@
# show - output the control
#]
-[.$ sub show_label_cell ($self)
+[.$ sub show_label_cell ($self, $req)
my $style = "";
$style = "white-space:nowrap;" if ($self->{labelnowrap}) ;
@@ -213,8 +223,8 @@
<td class="cLabelBox[$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]"
colspan="1" [$ if $style $]style="[+ $style +]"[$ endif $]>
[.-
- $self -> show_label ;
- $self -> show_label_icon ;
+ $self -> show_label ($req);
+ $self -> show_label_icon ($req) ;
-]
</td>
[- return 1; -]
@@ -222,17 +232,17 @@
[# ---------------------------------------------------------------------------
#
-# show_control - output the control
+# show_control - output the control itself
#]
-[$ sub show_control ($self) $][+ $self->{value} +][$endsub$]
+[$ sub show_control ($self, $req) $][+ $self->{value} +][$endsub$]
[# ---------------------------------------------------------------------------
#
# show_control_readonly - output the control as readonly
#]
-[$ sub show_control_readonly ($self) $][+ $self -> {value} || $fdat{$self -> {name}} +][$endsub$]
+[$ sub show_control_readonly ($self, $req) $][+ $self -> {value} || $fdat{$self -> {name}} +][$endsub$]
[# ---------------------------------------------------------------------------
@@ -240,12 +250,12 @@
# show_controll_cell - output the table cell for the control
#]
-[.$ sub show_control_cell ($self, $x)
+[.$ sub show_control_cell ($self, $req, $x)
my $span = $self->{width_percent} - $x ;
$]
<td class="cControlBox" colspan="[+ $span +]">
- [.* my @ret = $self -> is_readonly?$self -> show_control_readonly:$self -> show_control ; *]
+ [.* my @ret = $self -> is_readonly?$self -> show_control_readonly($req):$self -> show_control ($req); *]
</td>
[* return @ret ; *]
[$endsub$]
@@ -275,6 +285,10 @@
Create a new control
+=head2 init
+
+Init the new control
+
=head2 noframe
Do not draw frame border if this is the only control
@@ -289,45 +303,49 @@
=head2 show
-output the control
+Output the control
=head2 get_on_show_code
-returns JavaScript code that should be executed when the form becomes visible
+Returns JavaScript code that should be executed when the form becomes visible
+
+=head2 get_active_id
+
+Get the id of the value which is currently active
=head2 form
-return the form object of this control
+Return the form object of this control
=head2 show_sub_begin
-output begin of sub form
+Output begin of sub form
=head2 show_sub_end
-output end of sub form
+Output end of sub form
=head2 show_label
-output the label of the control
+Output the label of the control
=head2 show_label_icon
-output the icon after the label
+Output the icon after the label
=head2 show_label_cell
-output the table cell in which the label will be displayed
+Output the table cell in which the label will be displayed
Must return the columns it spans (default: 1)
=head2 show_control
-output the control itself
+Output the control itself
=head2 show_control_cell
-output the table cell in which the control will be displayed
+Output the table cell in which the control will be displayed
Gets the x position as argument
@@ -353,7 +371,7 @@
=head2 readonly
-If set, displays a readonly version of t control.
+If set, displays a readonly version of the control.
=head2 disable
@@ -376,6 +394,10 @@
With this parameter you can also specify the width of
the control in percent. This parameter take precendence over
C<width>
+
+=head2 default
+
+Default value of the control
=head1 AUTHOR
Modified: perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/checkbox.pm?view=diff&rev=474139&r1=474138&r2=474139
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/checkbox.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/checkbox.pm Sun Nov 12 20:39:49 2006
@@ -44,19 +44,19 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
#]
-[.$ sub show_control ($self)
+[.$ sub show_control ($self)
my $name = $self -> {name} ;
my $val = $self -> {value} || 1 ;
push @{$self -> form -> {fields2empty}}, $name ;
-$]
+$]
<input type="checkbox" class="cBase cControlCheckbox" name="[+ $name +]" value="[+ $val +]"
[$if ($self -> {sublines} || $self -> {subobjects}) $] OnClick="show_checked(this)" [$endif$]
>
@@ -73,9 +73,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'checkbox',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
value => 'bar'
}
@@ -95,7 +95,7 @@
Specifies the name of the checkbox control
-=head3 text
+=head3 text
Will be used as label for the checkbox control
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe[at]perl.apache.org
For additional commands, e-mail: embperl-cvs-help[at]perl.apache.org
|
