Mailing List Archive

Author: richter
Date: Sun Oct 1 13:06:43 2023
New Revision: 1912655

URL: http://svn.apache.org/viewvc?rev=1912655&view=rev
Log:
Update Embperl::Form

Added:
perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm
perl/embperl/trunk/Embperl/Form/Validate/IP6Addr_Mask.pm
perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr.pm
perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr_Mask.pm
Modified:
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Control.pm
perl/embperl/trunk/Embperl/Form/Control/blank.pm
perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
perl/embperl/trunk/Embperl/Form/Control/checkboxes.pm
perl/embperl/trunk/Embperl/Form/Control/datetime.pm
perl/embperl/trunk/Embperl/Form/Control/display.pm
perl/embperl/trunk/Embperl/Form/Control/duration.pm
perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm
perl/embperl/trunk/Embperl/Form/Control/dynlink.pm
perl/embperl/trunk/Embperl/Form/Control/grid.pm
perl/embperl/trunk/Embperl/Form/Control/inputlist.pm
perl/embperl/trunk/Embperl/Form/Control/mult.pm
perl/embperl/trunk/Embperl/Form/Control/password.pm
perl/embperl/trunk/Embperl/Form/Control/price.pm
perl/embperl/trunk/Embperl/Form/Control/select.pm
perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm
perl/embperl/trunk/Embperl/Form/Control/textarea.pm
perl/embperl/trunk/Embperl/Form/DataSource.pm
perl/embperl/trunk/Embperl/Form/Validate.pm
perl/embperl/trunk/Embperl/Form/Validate/DateTime.pm
perl/embperl/trunk/Embperl/Form/Validate/DateTimeEU.pm
perl/embperl/trunk/Embperl/Form/Validate/Default.pm
perl/embperl/trunk/Embperl/Form/Validate/Duration.pm
perl/embperl/trunk/Embperl/Form/Validate/EMail.pm
perl/embperl/trunk/Embperl/Form/Validate/EMailRFC.pm
perl/embperl/trunk/Embperl/Form/Validate/FQDN.pm
perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm
perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm
perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm
perl/embperl/trunk/Embperl/Form/Validate/Number.pm
perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm
perl/embperl/trunk/Embperl/Form/Validate/Select.pm
perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm
perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm
perl/embperl/trunk/Embperl/Inline.pm
perl/embperl/trunk/MANIFEST

Modified: perl/embperl/trunk/Embperl/Form.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Sun Oct 1 13:06:43 2023
@@ -11,8 +11,6 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id$
-#
###################################################################################


@@ -32,7 +30,7 @@ use Embperl::Inline ;
use Data::Dumper ;
use Storable ;
use MIME::Base64 ;
-use Scalar::Util qw{weaken} ;
+use Scalar::Util qw{weaken} ;

our %forms ;
our $form_cnt = 1 ;
@@ -52,7 +50,7 @@ sub sub_new
my ($class, $controls, $options, $id, $toplevel, $parentptr) = @_ ;

$id ||= 'topdiv' ;
- $options ||= {} ;
+ $options ||= {} ;
$toplevel = 1 if (!defined ($toplevel)) ;

my $self = ref $class?$class:{} ;
@@ -68,44 +66,44 @@ sub sub_new
$self -> {checkitems} = $options -> {checkitems} ;
$self -> {valign} = $options -> {valign} || 'top' ;
$self -> {jsnamespace} = $options -> {jsnamespace} || '' ;
- $self -> {jsnamespace} .= '.' if ($self -> {jsnamespace}) ;
+ $self -> {jsnamespace} .= '.' if ($self -> {jsnamespace}) ;
$self -> {disable} = $options -> {disable} ;
- $self -> {control_packages} = $options -> {control_packages} ;
- $self -> {datasrc_packages} = $options -> {datasrc_packages} ;
+ $self -> {control_packages} = $options -> {control_packages} ;
+ $self -> {datasrc_packages} = $options -> {datasrc_packages} ;
$self -> {formptr} = ($options -> {formptr} || "$self") . '/' . $id ;
bless $self, $class if (!ref $class);

# The following lines needs to there twice!
# some weired bug in Perl?
$Embperl::FormData::forms{$self -> {formptr}} = $self ;
- weaken($Embperl::FormData::forms{$self -> {formptr}});
+ weaken($Embperl::FormData::forms{$self -> {formptr}});
#$Embperl::FormData::forms{$self -> {formptr}} = $self ;

if ($toplevel)
{
$self -> {fields2empty} = [] ;
- $self -> {init_data} = [] ;
- $self -> {init_markup} = [] ;
+ $self -> {init_data} = [] ;
+ $self -> {init_markup} = [] ;
$self -> {prepare_fdat} = [] ;
- $self -> {code_refs} = [] ;
- $self -> {constrain_attrs} = [] ;
- $self -> {do_validate} = [] ;
- $self -> {all_controls} = {} ;
+ $self -> {code_refs} = [] ;
+ $self -> {constrain_attrs} = [] ;
+ $self -> {do_validate} = [] ;
+ $self -> {all_controls} = {} ;
}
else
{
$self -> {fields2empty} = $self -> parent_form -> {fields2empty} ;
- $self -> {init_data} = $self -> parent_form -> {init_data} ;
- $self -> {init_markup} = $self -> parent_form -> {init_markup} ;
- $self -> {prepare_fdat} = $self -> parent_form -> {prepare_fdat} ;
- $self -> {constrain_attrs} = $self -> parent_form -> {constrain_attrs} ;
- $self -> {code_refs} = $self -> parent_form -> {code_refs} ;
- $self -> {do_validate} = $self -> parent_form -> {do_validate} ;
+ $self -> {init_data} = $self -> parent_form -> {init_data} ;
+ $self -> {init_markup} = $self -> parent_form -> {init_markup} ;
+ $self -> {prepare_fdat} = $self -> parent_form -> {prepare_fdat} ;
+ $self -> {constrain_attrs} = $self -> parent_form -> {constrain_attrs} ;
+ $self -> {code_refs} = $self -> parent_form -> {code_refs} ;
+ $self -> {do_validate} = $self -> parent_form -> {do_validate} ;
$self -> {all_controls} = $self -> parent_form -> {all_controls} ;
}
if ($self -> has_code_refs)
{
- push @{$self -> {code_refs}}, $self ;
+ push @{$self -> {code_refs}}, $self ;
weaken ($self -> {code_refs}[-1]) ;
}
$self -> new_controls ($controls, $options, undef, $id, $options -> {masks}, $options -> {defaults}) ;
@@ -116,17 +114,28 @@ sub sub_new

return $self ;
}
-
-# ---------------------------------------------------------------------------
-#
-# new - create a new form
-#
-
-sub new
- {
- my $class = shift ;
- return $class -> sub_new (@_) ;
- }
+
+# ---------------------------------------------------------------------------
+#
+# new - create a new form
+#
+
+sub new
+ {
+ my $class = shift ;
+ return $class -> sub_new (@_) ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# clone - clone an existing form. trivial new here, maybe more complex for kids
+# This will always return a Embperl::Form, no matter what $self is
+
+sub cloned_form
+ {
+ my $self = shift ;
+ return Embperl::Form -> sub_new (@_) ;
+ }

# ---------------------------------------------------------------------------
#
@@ -197,13 +206,13 @@ sub new_object
{
local $SIG{__DIE__} ;
eval "require $name" ;
- }
+ }
if ($@)
{
my $modfile = $name . '.pm' ;
$modfile =~ s/::/\//g ;
if ($@ !~ /Can\'t locate $modfile/)
- {
+ {
die "require $name: $@" ;
}
}
@@ -232,13 +241,13 @@ sub new_object
{
local $SIG{__DIE__} ;
eval "require $mod" ;
- }
+ }
if ($@)
{
my $modfile = $mod . '.pm' ;
$modfile =~ s/::/\//g ;
if ($@ !~ /Can\'t locate $modfile/)
- {
+ {
die "require $mod: $@" ;
}
}
@@ -267,7 +276,7 @@ sub new_controls

{
my ($self, $controls, $options, $id, $formid, $masks, $defaults, $no_init) = @_ ;
-
+
my $n = 0 ;
my $packages = $self -> get_control_packages ;

@@ -282,10 +291,10 @@ sub new_controls
$ctlid = $control->{name} . '_' . $q ;
$q++ ;
}
-
+
my $name = $control -> {name} ;
- $control -> {type} =~ s/sf_select.+/select/ ;
- $control -> {type} ||= ($control -> {name}?'input':'blank') ;
+ $control -> {type} =~ s/sf_select.+/select/ ;
+ $control -> {type} ||= ($control -> {name}?'input':'blank') ;
$control -> {parentid} = $id if ($id) ;
$control -> {id} ||= $ctlid ;
$control -> {basename}||= $control->{name} ;
@@ -295,7 +304,7 @@ sub new_controls
my $type = $control -> {type} ;
my $default = $defaults -> {$name} || $defaults -> {"*$type"} || $defaults -> {'*'};
my $mask = $masks -> {$name} || $masks -> {"*$type"} || $masks -> {'*'};
-
+
if ($mask)
{
foreach (keys %$mask)
@@ -321,34 +330,34 @@ sub new_controls
{
push @{$self -> {init_data}}, $control ;
weaken ($self -> {init_data}[-1]) ;
- }
+ }
if ($control -> can ('init_markup'))
{
push @{$self -> {init_markup}}, $control ;
weaken ($self -> {init_markup}[-1]) ;
- }
+ }
if ($control -> can ('prepare_fdat'))
{
push @{$self -> {prepare_fdat}}, $control ;
weaken ($self -> {prepare_fdat}[-1]) ;
- }
+ }
if ($control -> has_code_refs)
{
push @{$self -> {code_refs}}, $control ;
weaken ($self -> {code_refs}[-1]) ;
- }
+ }
if ($control -> has_validate_rules)
{
push @{$self -> {do_validate}}, $control ;
weaken ($self -> {do_validate}[-1]) ;
- }
- push @{$self -> {constrain_attrs}}, $control -> constrain_attrs ;
+ }
+ push @{$self -> {constrain_attrs}}, $control -> constrain_attrs ;
$self -> {all_controls}{$name} = $control ;
weaken ($self -> {all_controls}{$name}) ;
}
}
- $self -> {controlids}{$control->{id}} = $control ;
-
+ $self -> {controlids}{$control->{id}} = $control ;
+
next if ($control -> is_disabled ()) ;
if ($control -> {sublines})
{
@@ -377,12 +386,12 @@ sub new_controls
$ctlid = $control->{name} . '_' . $q ;
$q++ ;
}
- my $class = ref $self ;
+ my $class = ref $self ;
local $options -> {disable} = $control -> {disables}[$i] ;
my $subform = $class -> sub_new ($subcontrols, $options, $ctlid, 0, $self -> {formptr}) ;
- $subform -> {text} ||= $control -> {options}[$i] if (exists ($control -> {options}) && $control -> {options}[$i]) ;
+ $subform -> {text} ||= $control -> {options}[$i] if (exists ($control -> {options}) && $control -> {options}[$i]) ;
$subform -> {parent_control} = $control ;
- weaken ($subform -> {parent_control}) ;
+ weaken ($subform -> {parent_control}) ;
push @ids, $ctlid ;
push @obj, $subform ;
$i++ ;
@@ -405,7 +414,7 @@ sub parent_form

return $Embperl::FormData::forms{$self -> {parentptr}} ;
}
-
+


# ---------------------------------------------------------------------------
@@ -442,16 +451,16 @@ sub layout
my $line = [] ;
my @lines ;
my $max_num = 0 ;
- my $num = 0 ;
+ my $num = 0 ;
my $last_state ;
foreach my $control (@$controls)
{
next if ($control -> is_disabled ()) ;
- if ($control -> is_hidden)
- {
- $control -> {width_percent} = 0 ;
- push @$hidden, $control ;
- next ;
+ if ($control -> is_hidden)
+ {
+ $control -> {width_percent} = 0 ;
+ push @$hidden, $control ;
+ next ;
}
my $width = ($control -> {width} eq 'expand')?100:$control -> {width_percent} || int($max_x / ($control -> {width} || 2)) ;
#$width = 21 if ($x == 0 && $width < 21) ;
@@ -467,11 +476,11 @@ sub layout
$x = 0 ;
$num = 0 ;
}
- push @$line, $control ;
+ push @$line, $control ;
$last_state = $control -> {state} ;
$control -> {width_percent} = $control -> {width} eq 'expand'?'expand':int($width) ;
$control -> {x_percent} = int($x) ;
- $control -> {level} = $level ;
+ $control -> {level} = $level ;
$x += $width ;
$num++ ;
$max_num = $num if ($num > $max_num) ;
@@ -506,14 +515,14 @@ sub layout
{
next if (!$subobj) ;
$subobj -> layout ;
- push @$hidden, @{$subobj -> {hidden}} ;
- delete $subobj -> {hidden} ;
+ push @$hidden, @{$subobj -> {hidden}} ;
+ delete $subobj -> {hidden} ;
}
}
}

if ($x > 0 && $x < $max_x)
- {
+ {
push @$line, Embperl::Form::Control::blank -> new (
{width_percent => int($max_x - $x), level => $level, x_percent => int($x), state => $last_state }) ;
$num++ ;
@@ -565,10 +574,10 @@ sub show_controls
my @obj ;
$control -> show_sub_begin ($req) ;
foreach my $subobj (@{$control -> {subobjects}})
- {
+ {

next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}} || $subobj -> is_disabled ($req)) ;
-
+
$subobj -> show ($req, $activesubid[$control -> {level}]) ;
}
$control -> show_sub_end ($req) ;
@@ -585,41 +594,41 @@ sub show_controls
return ;
}

-# ---------------------------------------------------------------------------
-#
-# init_validate - init validate functions
-#
-
-sub init_validate
-
- {
- my ($self, $req, $options) = @_ ;
-
- if ($self -> {toplevel})
- {
- my $epf = $self -> {validate} ;
- if (!defined ($epf))
- {
- my @validate_rules ;
- foreach my $control (@{$self -> {do_validate}})
- {
- push @validate_rules, $control -> get_validate_rules ($req) ;
- }
- if (@validate_rules)
- {
- $epf = $self -> {validate} = Embperl::Form::Validate -> new (\@validate_rules, $self -> {formname}, $options -> {language}, $options -> {charset}) ;
- $self -> add_code_at_bottom ($epf -> get_script_code) ;
- }
- else
- {
- $self -> add_code_at_bottom (" function epform_validate_$self->{formname} () { return false } ") ;
- $self -> {validate} = 0 ;
- }
- }
- }
-
- return $self -> {validate}?1:0 ;
- }
+# ---------------------------------------------------------------------------
+#
+# init_validate - init validate functions
+#
+
+sub init_validate
+
+ {
+ my ($self, $req, $options) = @_ ;
+
+ if ($self -> {toplevel})
+ {
+ my $epf = $self -> {validate} ;
+ if (!defined ($epf))
+ {
+ my @validate_rules ;
+ foreach my $control (@{$self -> {do_validate}})
+ {
+ push @validate_rules, $control -> get_validate_rules ($req) ;
+ }
+ if (@validate_rules)
+ {
+ $epf = $self -> {validate} = Embperl::Form::Validate -> new (\@validate_rules, $self -> {formname}, $options -> {language}, $options -> {charset}) ;
+ $self -> add_code_at_bottom ($epf -> get_script_code) ;
+ }
+ else
+ {
+ $self -> add_code_at_bottom (" function epform_validate_$self->{formname} () { return false } ") ;
+ $self -> {validate} = 0 ;
+ }
+ }
+ }
+
+ return $self -> {validate}?1:0 ;
+ }

# ---------------------------------------------------------------------------
#
@@ -633,57 +642,58 @@ sub show

if ($self -> {toplevel})
{
- $self -> init_validate ($req, $options) ;
+ $self -> init_validate ($req, $options) ;
$self -> init_data ($req) ;
$self -> show_form_begin ($req) ;
}
-
+
#$self -> validate ($req) if ($self -> {toplevel});
$self -> show_controls ($req, $activeid, $options) ;
$self -> show_form_end ($req) if ($self -> {toplevel});
}


-# ---------------------------------------------------------------------------
-#
-# init_data - init fdat before showing
-#
-
-sub init_data
-
- {
- my ($self, $req, $options) = @_ ;
-
- if ($self -> {toplevel} && $options)
- {
- $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
- }
- foreach my $control (@{$self -> {init_data}})
- {
- $control -> init_data ($req) if ($control -> should_init_data ($req)) ;
- }
- }
-
-# ---------------------------------------------------------------------------
-#
-# init_markup - add any dynamic markup to the form data
-#
-
-sub init_markup
-
- {
- my ($self, $req, $parentctl, $method, $options) = @_ ;
-
- if ($self -> {toplevel} && $options)
- {
- $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
- }
- foreach my $control (@{$self -> {init_markup}})
- {
- $control -> init_markup ($req, $parentctl, $method) if (!$control -> is_disabled ($req)) ;
- }
- }
-
+# ---------------------------------------------------------------------------
+#
+# init_data - init fdat before showing
+#
+
+sub init_data
+
+ {
+ my ($self, $req, $options) = @_ ;
+
+ if ($self -> {toplevel} && $options)
+ {
+ $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
+ }
+ foreach my $control (@{$self -> {init_data}})
+ {
+ next if (!$control) ;
+ $control -> init_data ($req) if ($control -> should_init_data ($req)) ;
+ }
+ }
+
+# ---------------------------------------------------------------------------
+#
+# init_markup - add any dynamic markup to the form data
+#
+
+sub init_markup
+
+ {
+ my ($self, $req, $parentctl, $method, $options) = @_ ;
+
+ if ($self -> {toplevel} && $options)
+ {
+ $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
+ }
+ foreach my $control (@{$self -> {init_markup}})
+ {
+ $control -> init_markup ($req, $parentctl, $method) if (!$control -> is_disabled ($req)) ;
+ }
+ }
+
# ---------------------------------------------------------------------------
#
# prepare_fdat - change fdat after submit
@@ -694,97 +704,97 @@ sub prepare_fdat
{
my ($self, $req, $options) = @_ ;

- if ($self -> {toplevel} && $options)
- {
- $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
- }
+ if ($self -> {toplevel} && $options)
+ {
+ $req -> {form_options_masks} = ($options && $options -> {masks}) || {} ;
+ }
foreach my $control (@{$self -> {prepare_fdat}})
{
$control -> prepare_fdat ($req) if (!$control -> is_disabled ($req)) ;
}
- }
-
-# ---------------------------------------------------------------------------
-#
-# is_disabled - do not display this control at all
-#
-
-sub is_disabled
-
- {
- my ($self, $req) = @_ ;
-
- my $disable = $self -> {disable} ;
-
- $disable = &{$disable}($self, $req) if (ref ($disable) eq 'CODE') ;
-
- return $disable ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# has_code_refs - returns true if is_readonly or is_disabled are coderefs
-#
-
-sub has_code_refs
-
- {
- my ($self, $req) = @_ ;
-
- return ref ($self -> {disable}) eq 'CODE' ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# code_ref_fingerprint - returns fingerprint of is_disabled
-#
-
-sub code_ref_fingerprint
-
- {
- my ($self, $req) = @_ ;
-
- return ($self -> is_disabled($req)?'D':'E') ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# all_code_ref_fingerprints - returns a fingerprint of the result of all code refs
-# can be used to check if is_readonly or is_disabled
-# has dynamicly changed
-#
-
-sub all_code_ref_fingerprints
-
- {
- my ($self, $req) = @_ ;
-
- my $fp ;
- foreach my $control (@{$self -> {code_refs}})
- {
- $fp .= $control -> code_ref_fingerprint ($req) ;
- }
- return $fp ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# constrain_attrs - returns attrs that might change the form layout
-# if there value changes
-#
-
-sub constrain_attrs
-
- {
- my ($self, $req) = @_ ;
-
- return $self -> {constrain_attrs} ;
- }
-
-
+ }
+
+# ---------------------------------------------------------------------------
+#
+# is_disabled - do not display this control at all
+#
+
+sub is_disabled
+
+ {
+ my ($self, $req) = @_ ;
+
+ my $disable = $self -> {disable} ;
+
+ $disable = &{$disable}($self, $req) if (ref ($disable) eq 'CODE') ;
+
+ return $disable ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# has_code_refs - returns true if is_readonly or is_disabled are coderefs
+#
+
+sub has_code_refs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return ref ($self -> {disable}) eq 'CODE' ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# code_ref_fingerprint - returns fingerprint of is_disabled
+#
+
+sub code_ref_fingerprint
+
+ {
+ my ($self, $req) = @_ ;
+
+ return ($self -> is_disabled($req)?'D':'E') ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# all_code_ref_fingerprints - returns a fingerprint of the result of all code refs
+# can be used to check if is_readonly or is_disabled
+# has dynamicly changed
+#
+
+sub all_code_ref_fingerprints
+
+ {
+ my ($self, $req) = @_ ;
+
+ my $fp ;
+ foreach my $control (@{$self -> {code_refs}})
+ {
+ $fp .= $control -> code_ref_fingerprint ($req) ;
+ }
+ return $fp ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return $self -> {constrain_attrs} ;
+ }
+
+
# ---------------------------------------------------------------------------
#
# validate - validate the form input
@@ -794,17 +804,17 @@ sub validate

{
my ($self, $fdat, $pref, $epreq) = @_ ;
-
+
my $validate = $self -> {validate} ;
my $result = $validate -> validate ($fdat, $pref, $epreq) ;
my @msgs ;
foreach my $err (@$result)
{
my $msg = $validate -> error_message ($err, $pref, $epreq) ;
- push @msgs, $msg ;
+ push @msgs, $msg ;
}

- return ($result, \@msgs) ;
+ return ($result, \@msgs) ;
}


@@ -851,9 +861,9 @@ sub add_tabs
}

if (@forms == 1)
- {
- return @{$forms[0]} ;
- }
+ {
+ return @{$forms[0]} ;
+ }

return {
section => 'cSectionText',
@@ -923,20 +933,21 @@ sub add_sublines
my $obj = Execute ({object => "$fn"} ) ;
$subfields = $obj -> fields ($epreq, $file) ;
}
- $subfields ||= [] ;
- foreach (@$subfields)
- {
- $_ -> {state} = $object_data -> {name} . '-show-' . ($file->{value} || $file->{name}) ;
- }
+ $subfields ||= [] ;
+ foreach (@$subfields)
+ {
+ $_ -> {state} = $object_data -> {name} . '-show-' . ($file->{value} || $file->{name}) ;
+ }
push @forms, $subfields ;
push @values, $file->{value} || $file->{name};
push @options, $file -> {text} || $file->{value} || $file->{name};
}
$object_data -> {trigger} = 1 ;
- return { %$object_data, type => $type || 'select',
- values => \@values, options => \@options, sublines => \@forms,
- };
-
+ return
+ {
+ %$object_data, type => $type || 'select',
+ values => \@values, options => \@options, sublines => \@forms,
+ };
}

#------------------------------------------------------------------------------------------
@@ -985,18 +996,18 @@ sub add_checkbox_subform
my $obj = Execute ({object => "./$fn"} ) ;
#$subfield = [.eval {$obj -> fields ($r, { %$file, %$args} ) || undef}];
}
-
- my $subfields = $subfield -> [0] ;
- foreach (@$subfields)
- {
- $_ -> {state} = $subform -> {name} . '-show' ;
- }
- $subfields = $subfield -> [1] ;
- foreach (@$subfields)
- {
- $_ -> {state} = $subform -> {name} . '-hide';
- }
-
+
+ my $subfields = $subfield -> [0] ;
+ foreach (@$subfields)
+ {
+ $_ -> {state} = $subform -> {name} . '-show' ;
+ }
+ $subfields = $subfield -> [1] ;
+ foreach (@$subfields)
+ {
+ $_ -> {state} = $subform -> {name} . '-hide';
+ }
+
return {type => 'checkbox' , trigger => 1, section => $section, width => $width, name => $name, text => $text, value => $value, sublines => $subfield}

}
@@ -1016,7 +1027,7 @@ sub add_checkbox_subform
sub convert_label
{
my ($self, $ctrl, $name, $text, $req) = @_ ;
-
+
return $text || $ctrl->{text} || $name || $ctrl->{name} ;
}

@@ -1036,7 +1047,7 @@ sub convert_label
sub convert_options
{
my ($self, $ctrl, $values, $options, $req) = @_ ;
-
+
return $options ;
}

@@ -1055,7 +1066,7 @@ sub convert_options
sub convert_text
{
my ($self, $ctrl, $value, $text, $req) = @_ ;
-
+
return $value || $ctrl->{text} || $ctrl->{name} ;
}

@@ -1074,7 +1085,7 @@ sub convert_text
sub diff_checkitems
{
my ($self, $check) = @_ ;
-
+
my %diff ;
my $checkitems = eval { Storable::thaw(MIME::Base64::decode ($Embperl::fdat{-checkitems})) } ;

@@ -1084,7 +1095,7 @@ sub diff_checkitems
$diff{$_} = 1 if ($checkitems -> {$_} ne $Embperl::fdat{$_}) ;
}

- return \%diff ;
+ return \%diff ;
}


@@ -1131,13 +1142,13 @@ onSubmit="v=doValidate; doValidate=1; re
[.$ sub show_controls_begin ($self, $req, $activeid)

my $parent = $self -> parent_form ;
-my $class = $self -> {options}{classdiv} || ($parent -> {noframe}?'ef-tabs-border-u':'ef-tabs-border') ;
+my $class = $self -> {options}{classdiv} || ($parent -> {noframe}?'ef-tabs-border-u':'ef-tabs-border') ;
my $parent_control = $self -> {parent_control} ;
$]
-
-[$if $parent_control && $parent_control -> can('show_subform_controls_begin') $]
-[- $parent_control -> show_subform_controls_begin ($self, $req, $activeid) -]
-[$else$]
+
+[$if $parent_control && $parent_control -> can('show_subform_controls_begin') $]
+[- $parent_control -> show_subform_controls_begin ($self, $req, $activeid) -]
+[$else$]
<div id="[+ $self -> {unique_id} +]_[+ $self->{id} +]" class="ef-tabs-content"
[$if ($activeid && $self->{id} ne $activeid) $] style="display: none" [$endif$]
>
@@ -1150,15 +1161,15 @@ $]
# show_controls_end - output end of form controls area
#]

-[.$sub show_controls_end ($self, $req)
- my $parent_control = $self -> {parent_control} ;
+[.$sub show_controls_end ($self, $req)
+ my $parent_control = $self -> {parent_control} ;
$]
-[$if $parent_control && $parent_control -> can('show_subform_controls_end') $]
-[- $parent_control -> show_subform_controls_end ($self, $req) -]
-[$else$]
+[$if $parent_control && $parent_control -> can('show_subform_controls_end') $]
+[- $parent_control -> show_subform_controls_end ($self, $req) -]
+[$else$]
[$ if (!$self -> {noframe}) $]</td></tr></table> [$endif$]
-</div>
-[$endif$]
+</div>
+[$endif$]

[$ if (@{$self->{bottom_code}}) $]
<script language="javascript">
@@ -1189,8 +1200,8 @@ $]
#]

[.$sub show_checkitems ($self, $req)
-
-my $checkitems = MIME::Base64::encode (Storable::freeze (\%idat)) ;
+
+my $checkitems = MIME::Base64::encode (Storable::freeze (\%idat)) ;
$]
<input type="hidden" name="-checkitems" value="[+ $checkitems +]">

@@ -1225,7 +1236,7 @@ $]<!-- line begin -->
[$if $id $] id="[+ $id +]" [$endif$]
[.$if ($activeid eq '-' || ($baseid eq $baseaid && $baseidn != $baseaidn)) $] style="display: none" [$endif$]
>
- #][.* return !($activeid eq '-' || ($baseid eq $baseaid && $baseidn != $baseaidn))
+ #][.* return !($activeid eq '-' || ($baseid eq $baseaid && $baseidn != $baseaidn))
*][$endsub$]

[.# ---------------------------------------------------------------------------
@@ -1352,17 +1363,17 @@ Gives the CSS class of the DIV around th
If set to true, allows one to call the function diff_checkitems after the data is
posted and see which form fields are changed.

-=item * control_packages
-
-Arrayref with package names to search for form controls. Alternatively you can
-overwrite the method get_control_packages.
-
-=item * datasrc_packages
-
-Arrayref with package names to search for form data source modules. Alternatively you can
-overwrite the method get_datasrc_packages.
-
-
+=item * control_packages
+
+Arrayref with package names to search for form controls. Alternatively you can
+overwrite the method get_control_packages.
+
+=item * datasrc_packages
+
+Arrayref with package names to search for form data source modules. Alternatively you can
+overwrite the method get_datasrc_packages.
+
+
=back

=back

Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Sun Oct 1 13:06:43 2023
@@ -11,8 +11,6 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id$
-#
###################################################################################

package Embperl::Form::Control ;
@@ -347,7 +345,7 @@ sub get_validate_rules
my ($self, $req) = @_ ;

my @local_rules ;
- if ($self -> {validate})
+ if ($self -> {validate} && @{$self -> {validate}} > 0)
{
@local_rules = ( -key => $self->{name} );
push @local_rules, -name => $self -> label_text ($req);

Modified: perl/embperl/trunk/Embperl/Form/Control/blank.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/blank.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/blank.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/blank.pm Sun Oct 1 13:06:43 2023
@@ -36,7 +36,7 @@ __EMBPERL__
$]<table class="ef-element ef-element-width-[+ $self -> {width_percent} +] ef-element-[+ $self -> {type} || 'blank' +] [+ ' ' . $self -> {state} +]">
<tr>
[#<td class="ef-label-box ef-label-box-width-100">[+ $self->{text} +]</td>#]
- <td class="ef-control-box ef-control-box-width-100">[+ $self->{text} +]</td>
+ <td class="ef-control-box ef-control-box-width-100"><div [.+ do { local $escmode = 0 ; $self -> get_std_control_attr($req, '', 'readonly') } +] _ef_divname="[+ $self -> {name} +]">[+ $self->{text} +]</div></td>
</tr>
</table>[$endsub$]


Modified: perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/checkbox.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/checkbox.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/checkbox.pm Sun Oct 1 13:06:43 2023
@@ -180,11 +180,24 @@ $]

my ($ctlattrs, $ctlid, $ctlname) = $self -> get_std_control_attr($req) ;
push @{$self -> form -> {fields2empty}}, $name ;
+
+ my $buttontext ;
+ if (ref $self -> {button})
+ {
+ if ($self -> {showtext})
+ {
+ $buttontext = join(',', @{$self -> {button}}) ;
+ }
+ else
+ {
+ $buttontext = join(',', map { $self -> form -> convert_text ($self, $_, undef, $req) } @{$self -> {button}}) ;
+ }
+ }
$]
<input type="checkbox" name="[+ $ctlname +]" [.+ do { local $escmode = 0 ; $ctlattrs } +] value="[+ $val +]"
[.$if ($self -> {trigger} || $self -> {button} || $self -> {timer}) $]_ef_attach="ef_checkbox"[$endif$]
[$if ($self -> {button}) $]_ef_button="1"[$endif$]
-[$if (ref $self -> {button}) $]_ef_buttonlabels="[+ join(',', @{$self -> {button}}) +]"[$endif$]
+[$if ($buttontext) $]_ef_buttonlabels="[+ $buttontext +]"[$endif$]
>[$if ($self -> {button}) $]<label for="[+ $ctlid +]"></label>[$endif$]
[$endsub$]


Modified: perl/embperl/trunk/Embperl/Form/Control/checkboxes.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/checkboxes.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/checkboxes.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/checkboxes.pm Sun Oct 1 13:06:43 2023
@@ -22,6 +22,7 @@ use vars qw{%fdat} ;
use base 'Embperl::Form::ControlMultValue' ;

use Embperl::Inline ;
+use URI::Escape ;

# ---------------------------------------------------------------------------
#
@@ -62,6 +63,33 @@ sub init_data
}

}
+
+# ------------------------------------------------------------------------------------------
+#
+# prepare_fdat - daten zusammenfuehren
+#
+
+sub prepare_fdat
+ {
+ my ($self, $req) = @_ ;
+
+ return if ($self -> is_readonly ($req)) ;
+
+ my $fdat = $req -> {form} || \%fdat ;
+ my $name = $self->{name} ;
+ if (exists $req -> {body})
+ {
+ # handle multiple checkboxes inside a grid
+ my $postdata = $req -> {body} ;
+ $name = uri_escape($name) ;
+ my $data = [ map { uri_unescape($_) } ($postdata =~ /\Q$name\E=(.*?)&/g) ] ;
+
+ my %attrs = map { ($_ => 1) } split /\s+/, $fdat -> {-fields2empty} ;
+ $fdat -> {$name} = $data if ($attrs{$name} || @$data > 0) ;
+ }
+
+
+ }
1 ;

__EMBPERL__

Modified: perl/embperl/trunk/Embperl/Form/Control/datetime.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/datetime.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/datetime.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/datetime.pm Sun Oct 1 13:06:43 2023
@@ -56,13 +56,12 @@ sub get_display_text
my ($self, $req, $time) = @_ ;

$time = $self -> get_value ($req) if (!defined ($time)) ;
-
- return $time if ($self -> {format} eq '-') ;
+ return $time if ($self -> {format} eq '-' || ($time =~ /\./)) ;
return if ($time eq '' && !exists $self -> {onempty}) ;

- if ($self -> {dynamic} && ($time =~ /^\s*((?:s|i|h|d|w|m|y|q)(?:\+|-)?(?:\d+)?)\s*$/))
+ if ($self -> {dynamic} && ($time =~ /^\s*((?:s|i|h|d|w|m|y|q)(?:\+|-)?(?:\d+)?)\s*/))
{
- return $1 ;
+ return $time ;#$1 ;
}


@@ -89,16 +88,32 @@ sub get_display_text
($y, $m, $d, $h, $min, $s, $z) = (($time . '00000000000000Z') =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(.)/) ;
}

- # Getting the local timezone
-
- my $date = eval
+ my $date ;
+ if ($time =~ /^(\d\d\d\d)-(\d+)$/)
+ {
+ $date = $time ;
+ }
+ elsif ($d == 0 && $m == 0)
{
- my @time = gmtime(timegm_nocheck($s,$min,$h,$d,$m-1,$y-1900)+($tz_local*60));
+ $date = $y ;
+ }
+ elsif ($d == 0)
+ {
+ $date = "$m.$y" ;
+ }
+ else
+ {
+ # Getting the local timezone
+
+ $date = eval
+ {
+ my @time = gmtime(timegm_nocheck($s,$min,$h,$d,$m-1,$y-1900)+($tz_local*60));

- my $format = $self -> {notime} || ($s == 0 && $h == 0 && $min == 0)?'%d.%m.%Y':'%d.%m.%Y, %H:%M' ;
- $format = '%d.%m.%Y, %H:%M:%S' if ($self -> {fulltime}) ;
- strftime ($format, @time[0..5]) ;
- } ;
+ my $format = $self -> {notime} || ($s == 0 && $h == 0 && $min == 0)?'%d.%m.%Y':'%d.%m.%Y, %H:%M' ;
+ $format = '%d.%m.%Y, %H:%M:%S' if ($self -> {fulltime}) ;
+ strftime ($format, @time[0..5]) ;
+ } ;
+ }

if ($time && !$date && ($time =~ /\d+\.\d+\.\d+/))
{
@@ -134,6 +149,7 @@ sub init_data
my $fdat = $req -> {docdata} || \%fdat ;
my $name = $self->{name} ;
my $time = $fdat->{$name} ;
+
return if (($time eq '' && !exists $self -> {onempty}) || $self -> {format} eq '-' || ($req -> {"ef_datetime_init_done_$name"} && !$force)) ;

$fdat->{$name} = $self -> get_display_text ($req, $time) ;
@@ -234,9 +250,9 @@ sub prepare_fdat
my $date = $fdat -> {$name} ;
return if ($date eq '') ;

- if ($self -> {dynamic} && ($date =~ /^\s*((?:s|i|h|d|w|m|y|q)\s*(?:\+|-)?\s*(?:\d+)?)\s*$/))
+ if ($self -> {dynamic} && ($date =~ /^\s*((?:s|i|h|d|w|m|y|q)\s*(?:\+|-)?\s*(?:\d+)?)\s*/))
{
- $fdat->{$name} = $1 ;
+ $fdat->{$name} = $date ; #$1 ;
$fdat->{$name} =~ s/\s//g ;
return ;
}

Modified: perl/embperl/trunk/Embperl/Form/Control/display.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/display.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/display.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/display.pm Sun Oct 1 13:06:43 2023
@@ -66,9 +66,12 @@ sub init_data
}
}

+
+
if (ref $value eq 'ARRAY')
{
- $fdat->{$name} = join ("<br>\n", @$value) ;
+ # $fdat->{$name} = join ("<br>\n", @$value) ;
+ $fdat->{$name} = $value ;
}
}

@@ -84,7 +87,18 @@ sub init_markup

my $fdat = $req -> {docdata} || \%fdat ;
my $name = $self->{name} ;
- $fdat->{$name} = HTML::Escape::escape_html ($fdat->{$name}) ;
+ my $value = $fdat->{$name} ;
+ $value = [ split /\t/, $value ] if $self->{split};
+ $value = [ split /\n/, $value ] if $self->{splitlines};
+ if (ref $value eq 'ARRAY')
+ {
+ @$value = map { $_ = HTML::Escape::escape_html ($_) } @$value ;
+ $fdat->{$name} = join ("<br>\n", @$value) ;
+ }
+ else
+ {
+ $fdat->{$name} = HTML::Escape::escape_html ($fdat->{$name}) ;
+ }
}

# ------------------------------------------------------------------------------------------

Modified: perl/embperl/trunk/Embperl/Form/Control/duration.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/duration.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/duration.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/duration.pm Sun Oct 1 13:06:43 2023
@@ -54,12 +54,23 @@ sub get_display_text
my $sec = $aval % 60 ;
my $min = int ($aval / 60) % 60 ;
my $hour = int($aval / 3600) ;
-
+ my $days ;
+ if ($self -> {days})
+ {
+ $hour %= 24 ;
+ $days = int($aval / 86400) ;
+ }
+
my $duration = ($val<0?'-':'') . (sprintf('%d:%02d', $hour, $min)) ;
- if ($sec != 0)
- {
- $duration .= sprintf (':%02d', $sec) ;
- }
+ if ($sec != 0 && !$self -> {nosec})
+ {
+ $duration .= sprintf (':%02d', $sec) ;
+ }
+ if ($days != 0)
+ {
+ $duration = sprintf ('%dd %s', $days, $duration) ;
+ }
+ $duration = '-' . $duration if ($val<0) ;

return $duration ;
}
@@ -202,12 +213,19 @@ Gives the maximun length in characters
=head3 unit

Gives a string that should be displayed right of the input field.
-(Default: ?)

=head3 use_comma

If set the decimal character is comma instead of point (Default: on)

+=head3 days
+
+Show days, e.g. 1d 22:30
+
+=head3 nosec
+
+Do not show seconds
+
=head1 Author

G. Richter (richter at embperl dot org)

Modified: perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm Sun Oct 1 13:06:43 2023
@@ -1,45 +1,45 @@
-
-###################################################################################
-#
+
+###################################################################################
+#
# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de
-# Embperl - Copyright (c) 2008-2014 Gerald Richter
-#
-# 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::Control::dynctrl ;
-
-use strict ;
-use base 'Embperl::Form::Control' ;
-
-use Embperl::Inline ;
-
-# ----------------------------------------------------------------------------
-#
-# creatre_ctrl - creates the dynamic control based on the current data
-#
-
-sub create_ctrl
- {
- my ($self, $req) = @_ ;
-
- my $fdat = ($req -> {form} && keys (%{$req -> {form}}) > 0)?$req -> {form}:$req -> {docdata} || \%Embperl::fdat ;
+# Embperl - Copyright (c) 2008-2014 Gerald Richter
+#
+# 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::Control::dynctrl ;
+
+use strict ;
+use base 'Embperl::Form::Control' ;
+
+use Embperl::Inline ;
+
+# ----------------------------------------------------------------------------
+#
+# creatre_ctrl - creates the dynamic control based on the current data
+#
+
+sub create_ctrl
+ {
+ my ($self, $req) = @_ ;
+
+ my $fdat = ($req -> {form} && keys (%{$req -> {form}}) > 0)?$req -> {form}:$req -> {docdata} || \%Embperl::fdat ;
my $id = $self -> {id} . $self -> {name} ;
- #::dbg('create_control id = ', $id, ' name = ', $self -> {name}, ' value = ', $fdat -> {$self -> {name}}, $fdat) ;
- #$req -> {form}, \%Embperl::fdat, $fdat, $req -> {docdata}, $req) ;
+ #::dbg('create_control id = ', $id, ' name = ', $self -> {name}, ' value = ', $fdat -> {$self -> {name}}, $fdat) ;
+ #$req -> {form}, \%Embperl::fdat, $fdat, $req -> {docdata}, $req) ;
#Carp::cluck ('cc') ;
return $req -> {"dynctrl_$id"} if ($req -> {"dynctrl_$id"}) ;
-
- my $ctrl ;
- my $ctrlattr = $self -> {ctrlattr} ;
+
+ my $ctrl ;
+ my $ctrlattr = $self -> {ctrlattr} ;
if (ref $ctrlattr eq 'CODE')
{
$ctrl = &{$ctrlattr}($self, $fdat, $req) ;
@@ -47,106 +47,115 @@ sub create_ctrl
else
{
$ctrl = {} ;
- foreach my $f (keys %$ctrlattr)
- {
- my $val = $ctrlattr -> {$f} ;
- if (ref $val eq 'CODE')
- {
- $val = &{$val}($self, $fdat, $req) ;
- }
-
- $ctrl -> {$f} = $val ;
- }
+ foreach my $f (keys %$ctrlattr)
+ {
+ my $val = $ctrlattr -> {$f} ;
+ if (ref $val eq 'CODE')
+ {
+ $val = &{$val}($self, $fdat, $req) ;
+ }
+
+ $ctrl -> {$f} = $val ;
+ }
}
foreach my $attr (keys %$self)
{
- $ctrl -> {$attr} = $self -> {$attr}
- if ($attr ne 'ctrlattr' &&
- $attr ne 'type' &&
+ $ctrl -> {$attr} = $self -> {$attr}
+ if ($attr ne 'ctrlattr' &&
+ $attr ne 'type' &&
!exists ($ctrl -> {$attr})) ;
- }
- foreach my $attr (qw{name fullid id state})
- {
- $ctrl -> {$attr} = $self -> {$attr} ;
- }
- $ctrl -> {text} = $ctrl -> {textprefix} . $ctrl -> {text} if ($ctrl -> {textprefix}) ;
- my $parent_form = $self -> form ;
- my $form = $req -> {dynctrl_form} ||= Embperl::Form -> new ([],
- {
- control_packages => $parent_form -> {control_packages},
- datasrc_packages => $parent_form -> {datasrc_packages},
- charset => $parent_form -> {options}{charset},
- language => $parent_form -> {options}{language},
- }) ;
-
- # make sure convert_xxx overloads works
- bless $form, ref $parent_form ;
- #my $form = $self -> form ;
- my $ctrlform = [$ctrl] ;
+ }
+ foreach my $attr (qw{name fullid id state})
+ {
+ $ctrl -> {$attr} = $self -> {$attr} ;
+ }
+ $ctrl -> {text} = $ctrl -> {textprefix} . $ctrl -> {text} if ($ctrl -> {textprefix}) ;
+ my $parent_form = $self -> form ;
+ my $form = $req -> {dynctrl_form} ||= $parent_form -> cloned_form ([],
+ {
+ control_packages => $parent_form -> {control_packages},
+ datasrc_packages => $parent_form -> {datasrc_packages},
+ charset => $parent_form -> {options}{charset},
+ language => $parent_form -> {options}{language},
+ }) ;
+
+ # make sure convert_xxx overloads works
+ bless $form, ref $parent_form ;
+ #my $form = $self -> form ;
+ my $ctrlform = [$ctrl] ;
$form -> new_controls ($ctrlform, undef, undef, undef, undef, undef, undef, 1) ;
-#::dbgcycle ($form) ;
-#::dbgcycle ($req) ;
- return $req -> {"dynctrl_$id"} = $ctrlform -> [0] ;
- }
-
+#::dbgcycle ($form) ;
+#::dbgcycle ($req) ;
+ return $req -> {"dynctrl_$id"} = $ctrlform -> [0] ;
+ }
+
+# ----------------------------------------------------------------------------
+
+sub _adapt_markup_source
+ {
+
+ }
+
+
# ----------------------------------------------------------------------------
-
-sub init_markup
+
+sub init_markup
{
my ($self, $req, $grid, $method) = @_ ;
- my $ctrl = $self -> create_ctrl ($req) ;
- return if (!$ctrl) ;
- my $name = $self -> {name} ;
+ my $ctrl = $self -> create_ctrl ($req) ;
+ return if (!$ctrl) ;
+ my $name = $self -> {name} ;
my $fdat = $req -> {docdata} || \%Embperl::fdat ;
-
- my $output ;
- my @errors ;
- $method ||= 'show' ;
-
- my $src = '$param[1] -> ' . $method . ' ($param[2])' ;
- my $rc = Embperl::Execute ({ inputfile => 'dynctrl' . $method,
- input => \$src,
- mtime => 1,
- syntax => 'Perl',
- param => [$self, $ctrl, $req],
- output => \$output,
- errors => \@errors,
- options => 262144,
- }) ;
- die \@errors if ($rc) ;
-
- #::dbg($ctrl, $output) ;
+
+ my $output ;
+ my @errors ;
+ $method ||= 'show' ;
+
+ my $src = '$param[1] -> ' . $method . ' ($param[2])' ;
+ $self -> _adapt_markup_source (\$src) ;
+ my $rc = Embperl::Execute ({ inputfile => 'dynctrl' . $method,
+ input => \$src,
+ mtime => 1,
+ syntax => 'Perl',
+ param => [$self, $ctrl, $req],
+ output => \$output,
+ errors => \@errors,
+ options => 262144,
+ }) ;
+ die \@errors if ($rc) ;
+
+ #::dbg($ctrl, $output) ;
$fdat -> {'_ctl_' . $name} = Encode::decode ('utf8', $output) ;
}

-

-# ---------------------------------------------------------------------------
-#
-# should_init_data - returns true if init_data should be called for this control
-#
-
-sub should_init_data
-
- {
- my ($self, $req) = @_ ;
-
- return !$self -> is_disabled ($req) ;
- }
-
-# ----------------------------------------------------------------------------
-
-sub init_data
- {
- my $self = shift ;
- my $ctrl = $self -> create_ctrl ($_[0]) ;
-
- $ctrl -> init_data (@_) if ($ctrl && $ctrl -> can ('init_data'));
- }
-
+
+# ---------------------------------------------------------------------------
+#
+# should_init_data - returns true if init_data should be called for this control
+#
+
+sub should_init_data
+
+ {
+ my ($self, $req) = @_ ;
+
+ return !$self -> is_disabled ($req) ;
+ }
+
+# ----------------------------------------------------------------------------
+
+sub init_data
+ {
+ my $self = shift ;
+ my $ctrl = $self -> create_ctrl ($_[0]) ;
+
+ $ctrl -> init_data (@_) if ($ctrl && $ctrl -> can ('init_data'));
+ }
+
# ----------------------------------------------------------------------------

-sub prepare_fdat
+sub prepare_fdat
{
my $self = shift ;
my $ctrl = $self -> create_ctrl ($_[0]) ;
@@ -155,127 +164,132 @@ sub prepare_fdat
}


-1 ;
-
-__EMBPERL__
-
-[.# ---------------------------------------------------------------------------
-#
-# show - output the whole control including the label
-#]
-
-[.$sub show ($self, $req)
-
-my $ctrl = $self -> create_ctrl ($req) ;
-my $name = $self -> {name} ;
-local $req -> {dynctrl_in_show} = 1 ;
-$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show ($req) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
-
-[# ---------------------------------------------------------------------------
-#
-# show_control
-#]
-
-[.$sub show_control ($self, $req)
-
-my $ctrl = $self -> create_ctrl ($req) ;
-my $name = $self -> {name} ;
-
-if ($req -> {dynctrl_in_show})
- {
- return $ctrl -> show_control ($req) ;
- }
-local $req -> {dynctrl_in_show} = 1 ;
-$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show_control ($req) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
-
-[# ---------------------------------------------------------------------------
-#
-# show_control
-#]
-
-[.$sub show_control_readonly ($self, $req, $value)
-
-my $ctrl = $self -> create_ctrl ($req) ;
-my $name = $self -> {name} ;
-if ($req -> {dynctrl_in_show})
- {
- return $ctrl -> show_control_readonly ($req, $value) ;
- }
-local $req -> {dynctrl_in_show} = 1 ;
-$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show_control_readonly ($req, $value) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Embperl::Form::Control::dynctrl - A dynamic control which is build depending on form data inside an Embperl Form
-
-
-=head1 SYNOPSIS
-
- {
- type => 'dynctrl',
- text => 'blabla',
- name => 'foo',
- ctrlattr =>
+1 ;
+
+__EMBPERL__
+
+[.# ---------------------------------------------------------------------------
+#
+# show - output the whole control including the label
+#]
+
+[.$sub show ($self, $req)
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show ($req) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
+
+[# ---------------------------------------------------------------------------
+#
+# show_control
+#]
+
+[.$sub show_control ($self, $req)
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+push @{$self -> form -> {fields2empty}}, $name if ($self -> {fields2empty});
+
+if ($req -> {dynctrl_in_show})
+ {
+ return $ctrl -> show_control ($req) ;
+ }
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show_control ($req) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
+
+[# ---------------------------------------------------------------------------
+#
+# show_control
+#]
+
+[.$sub show_control_readonly ($self, $req, $value)
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+if ($req -> {dynctrl_in_show})
+ {
+ return $ctrl -> show_control_readonly ($req, $value) ;
+ }
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[.- $ctrl -> show_control_readonly ($req, $value) if ($ctrl && !$req -> {update_docclass_info}) -]</div>[$ endsub $]
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Embperl::Form::Control::dynctrl - A dynamic control which is build depending on form data inside an Embperl Form
+
+
+=head1 SYNOPSIS
+
+ {
+ type => 'dynctrl',
+ text => 'blabla',
+ name => 'foo',
+ ctrlattr =>
{
type => sub { my ($ctrl, $fdat, $req) = @_ ; return $fdat{foo} },
size => sub { my ($ctrl, $fdat, $req) = @_ ; return $fdat{bar} },
}
- }
+ }

or

- {
+ {
type => 'dynctrl',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
ctrlattr => sub { my ($ctrl, $fdat, $req) = @_ ; return { type => $fdat{foo}, size => $fdat{bar} },
}
-
-
-
-=head1 DESCRIPTION
-
-Used to create a dynamic control which is build depending on form data inside an Embperl Form.
-See Embperl::Form on how to specify parameters.

-Use the ctrlattr parameter to specify a callback that delviers the control parameter
+
+
+=head1 DESCRIPTION
+
+Used to create a dynamic control which is build depending on form data inside an Embperl Form.
+See Embperl::Form on how to specify parameters.
+
+Use the ctrlattr parameter to specify a callback that delviers the control parameter
at runtime.
-
-=head2 PARAMETER
-
-=head3 type
-
-Needs to be 'dynctrl'
-
-=head3 name
-
-Specifies the name of the control
-
-=head3 text
-
-Will be used as label for the text input control
-
-
-=head3 ctrlattr
-
+
+=head2 PARAMETER
+
+=head3 type
+
+Needs to be 'dynctrl'
+
+=head3 name
+
+Specifies the name of the control
+
+=head3 text
+
+Will be used as label for the text input control
+
+
+=head3 ctrlattr
+
Code Referenz or hash of values and code references which returns the
attributes for the real control.

=head3 textprefix

-Prefix for text
-
-=head1 Author
-
-G. Richter (richter at embperl dot org)
-
-=head1 See Also
-
-perl(1), Embperl, Embperl::Form
-
-
+Prefix for text
+
+=head3 fields2empty
+
+Put field in fields2empty array. This necessary for checkboxes to be unchecked.
+
+=head1 Author
+
+G. Richter (richter at embperl dot org)
+
+=head1 See Also
+
+perl(1), Embperl, Embperl::Form
+
+

Modified: perl/embperl/trunk/Embperl/Form/Control/dynlink.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/dynlink.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/dynlink.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/dynlink.pm Sun Oct 1 13:06:43 2023
@@ -37,7 +37,7 @@ sub show_control_readonly
1 ;

__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
@@ -50,22 +50,24 @@ my $fields = $self -> {fields} ;
my $form = $self -> form ;
my $showoptions = $self -> {showoptions} ;
my $state = $self -> {state} ;
-
+my $localid = $self -> {localid} ;
$]
<div [.+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +]>
+[$ if ($localid) $]<form><input type="hidden" name="_id" value="[+ $req -> {docdata}{_id}+]">[$ endif $]
[$ foreach $field (@$fields) $]
<a class="[+ $state +]" [.+ do { local $escmode = 0 ; $self -> {eventattrs} } +] _ef_attach="ef_dynlink"
_ef_text="[+ $field -> {dyntext} +]"
_ef_name="[+ $name +]"
_ef_linkname="[+ $field -> {name} +]"
- [$if $field -> {target} $]target="[+ $field -> {target} +]" [$endif$]
- [$if $field -> {updref} $]href="#" _ef_updref="[.+ do { local $escmode = 0 ; $field -> {updref} } +]" _ef_updurl="[.+ do { local $escmode = 0 ; $field -> {updurl} } +]" [$endif$]
- [$if $field -> {href} $]href="[.+ do { local $escmode = 0 ; $field -> {href} } +]" _ef_xref="[.+ do { local $escmode = 0 ; $field -> {href} } +]" [$endif$]
- [$if $field -> {click} $]_ef_click="[.+ do { local $escmode = 0 ; $field -> {click} } +]" [$if !$field -> {href} $]href="#"[$endif$][$endif$]
+ [$if $field -> {target} $]target="[+ $field -> {target} +]" [$endif$]
+ [$if $field -> {updref} $]href="#" _ef_updref="[.+ do { local $escmode = 0 ; $field -> {updref} } +]" _ef_updurl="[.+ do { local $escmode = 0 ; $field -> {updurl} } +]" [$endif$]
+ [$if $field -> {href} $]href="[.+ do { local $escmode = 0 ; $field -> {href} } +]" _ef_xref="[.+ do { local $escmode = 0 ; $field -> {href} } +]" [$endif$]
+ [$if $field -> {download} $]_ef_download="[.+ do { local $escmode = 0 ; $field -> {download} } +]" [$if !$field -> {href} $]href="#"[$endif$][$endif$]
+ [$if $field -> {click} $]_ef_click="[.+ do { local $escmode = 0 ; $field -> {click} } +]" [$if !$field -> {href} $]href="#"[$endif$][$endif$]
[.+ do { local $escmode = 0 ; $self -> {eventattrs} } +]>
[$ if $showoptions < 0 $][.+ do { local $escmode = 0 ; $field -> {text} } +][$else$][.+ $showoptions?$field -> {text}:$form -> convert_text ($self, $field -> {name}, $field -> {text}, $req) +][$endif$]
</a>&nbsp;
-[$endforeach$]
+[$endforeach$][$ if ($localid) $]</form>[$ endif $]
[$ if $self->{hidden} $]
<input type="hidden" name="[+ $name +]">
[$endif$]
@@ -81,7 +83,7 @@ Embperl::Form::Control::dynlink - A cont

=head1 SYNOPSIS

- {
+ {
type => 'dynlink',
text => 'blabla',
fields =>
@@ -103,7 +105,7 @@ See Embperl::Form on how to specify para

Needs to be set to 'dynlink'.

-=head3 text
+=head3 text

Will be used as label for the text display control.


Modified: perl/embperl/trunk/Embperl/Form/Control/grid.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/grid.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/grid.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/grid.pm Sun Oct 1 13:06:43 2023
@@ -119,7 +119,7 @@ sub init_data_hash
}

[$rowno++, @data ]
- } keys %$hashdata ;
+ } sort keys %$hashdata ;

}

@@ -195,7 +195,7 @@ sub init_data
$col = exists $field -> {col}?$field -> {col}:$j ;
if ($colval = $field -> {colval})
{
- $fdat->{"__${name}_${j}_$i"} = $data->[$col+$coloffset] =~ /\Q$colval\E/?1:0 ;
+ $fdat->{"__${name}_${j}_$i"} = ($data->[$col+$coloffset] =~ /\Q$colval\E/)?1:0 ;
}
else
{
@@ -360,7 +360,14 @@ sub prepare_fdat
}
if ($self -> {datatype} eq 'hash')
{
- $fdat->{$name} = { map { ($_->[1] => $_->[2]) } @rows } ;
+ if (exists $self -> {hasharray})
+ {
+ $fdat->{$name} = { map { ( shift @$_ => \@$_ ) } @rows } ;
+ }
+ else
+ {
+ $fdat->{$name} = { map { ($_->[1] => $_->[2]) } @rows } ;
+ }
}
else
{
@@ -552,7 +559,7 @@ $]<table class="ef-element ef-element-wi
$]
<table class="cBase cGridTitle [+ $self -> {state} +]">
<tr class="cTableRow">
- <td class="cBase cGridLabelBox">[.+ $self -> form -> convert_label ($self, undef, undef, $req) +]</td>
+ <td class="cBase cGridLabelBox" _ef_attr="[+ $self -> {name} +]">[.+ $self -> form -> convert_label ($self, undef, undef, $req) +]</td>
[$if !($self -> is_readonly ($req)) && !$self -> {disable_controls} $]
<td class="cBase cGridControlBox">
<div>
@@ -633,9 +640,18 @@ $]
my $gridro = $self -> is_readonly ($req) ;
my $ro ;
my $j = 0 ;
+ my $rowclass = $self -> {rowclasses}[$i];
+ if ($req -> {only_one_css_class})
+ {
+ $rowclass ||= 'cGridRow' ;
+ }
+ else
+ {
+ $rowclass = 'cGridRow ' . $rowclass ;
+ }
$]
-
- <tr class="cGridRow [+ $self -> {rowclasses}[$i] +]" id="[+ "$id-row-$i" +]">
+
+ <tr class="[+ $rowclass +]" id="[+ "$id-row-$i" +]">
[$foreach $field (@$fields)$]
[$if $field -> is_hidden $][.-
local $field -> {name} = "__${name}_${j}_$i" ;

Modified: perl/embperl/trunk/Embperl/Form/Control/inputlist.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/inputlist.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/inputlist.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/inputlist.pm Sun Oct 1 13:06:43 2023
@@ -113,7 +113,7 @@ String to display between the input boxe

=head1 Author

-H. Jung
+H. Jung (jung@dev.ecos.de)

=head1 See Also


Modified: perl/embperl/trunk/Embperl/Form/Control/mult.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/mult.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/mult.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/mult.pm Sun Oct 1 13:06:43 2023
@@ -77,19 +77,25 @@ sub init_data

my $field = $self -> {fields}[0] ;
my $i = 0 ;
+ my @opt ;
+ my @data ;
foreach my $entry (@entries)
{
$fdat->{"__${name}__$i"} = $entry ;
- if ($field -> can ('init_data'))
+ if (1) #$field -> can ('init_data'))
{
local $field->{name} = "__${name}__$i" ;
local $field -> {fullid} = "$self->{fullid}__$i" ;
- $field -> init_data ($req, $self) ;
+ $field -> init_data ($req, $self) if ($field -> can ('init_data')) ;
+ push @data, $fdat->{$field->{name}} ;
+ push @opt, $fdat->{'_opt_' . $field->{name}} // $self -> get_display_text ($req, $entry) ;
}

$i++ ;
}
$fdat->{"__${name}_max"} = $i?$i:1;
+ $fdat->{$name} //= join ("\t", @data);
+ $fdat->{'_opt_' . $name} //= join (", ", @opt);
}

# ------------------------------------------------------------------------------------------

Modified: perl/embperl/trunk/Embperl/Form/Control/password.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/password.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/password.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/password.pm Sun Oct 1 13:06:43 2023
@@ -74,8 +74,7 @@ sub get_validate_auto_rules

$req ||= $Embperl::req ;
my $text = $self -> form -> convert_label ($self, $self->{retype_name}, undef, $req) ;
- return [. "same", $self->{retype_name} . ':' . $text, ($self -> {required}?(required => 1):(emptyok => 1)), length_min => 4 ] ;
- #return [. "same", $self->{retype_name}, ($self -> {required}?(required => 1):(emptyok => 1)), length_min => 4 ] ;
+ return [. -frontend_only, "same", $self->{retype_name} . ':' . $text, ($self -> {required}?(required => 1):(emptyok => 1)), length_min => 4 ] ;
}



Modified: perl/embperl/trunk/Embperl/Form/Control/price.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/price.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/price.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/price.pm Sun Oct 1 13:06:43 2023
@@ -35,7 +35,8 @@ sub init
my ($self) = @_ ;

$self -> {use_comma} = 1 if (!defined $self -> {use_comma}) ;
- $self->{unit} = 'euro' if (!defined ($self->{unit} ));
+ $self -> {unit} = 'euro' if (!defined ($self->{unit} ));
+ $self -> {decimals} = 2 if (!defined ($self->{decimals} ));

return $self ;
}
@@ -51,6 +52,7 @@ sub get_display_text

$val = $self -> get_value ($req) if (!defined ($val)) ;

+ my $decimals = $self -> {decimals} ;
my $sep ;
my $dec ;
my $int ;
@@ -78,8 +80,8 @@ sub get_display_text

$int[0] =~ s/^0+// ;
$int[0] = '0' if (@int == 1 && !$int[0]) ;
- $frac = substr ($frac . '00', 0, 2) ;
- my $result = ($minus?'-':'') . join ($sep, @int) . $dec . $frac ;
+ $frac = substr ($frac . '00000', 0, $decimals) ;
+ my $result = ($minus?'-':'') . join ($sep, @int) . ( $decimals ? $dec . $frac : '') ;
return $result if ($compact || $val eq '') ;

my $unit = $self->{unit} ;
@@ -187,7 +189,6 @@ Gives the maximun length in characters
=head3 unit

Gives a string that should be displayed right of the input field.
-(Default: ¤)

=head3 use_comma


Modified: perl/embperl/trunk/Embperl/Form/Control/select.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/select.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/select.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/select.pm Sun Oct 1 13:06:43 2023
@@ -38,7 +38,7 @@ sub show_control
{
my ($self, $req, $filter) = @_ ;

-push @{$req -> {timing}}, ([Time::HiRes::gettimeofday], 'start show_control ' . $self->{name} . ' ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});
+push @{$req -> {timing}}, ([Time::HiRes::gettimeofday()], 'start show_control ' . $self->{name} . ' ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});

my $name = $self -> {name} ;
my $fdat = $req -> {docdata} || \%Embperl::fdat ;
@@ -57,7 +57,7 @@ push @{$req -> {timing}}, ([.Time::HiRes:
my $out = '<select name="' .escape_html ($ctlname) . '" ' . $ctlattrs ;
$out .= ' size="' . escape_html ($self->{rows}) . '" ' if ($self->{rows}) ;
$out .= ' _ef_attach="ef_select" ' if ($self -> {trigger}) ;
- push @{$req -> {timing}}, ([Time::HiRes::gettimeofday], 'start show_control4 ' . $self->{name} . ' value: ' . scalar(@$values) . ' : ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});
+ push @{$req -> {timing}}, ([Time::HiRes::gettimeofday()], 'start show_control4 ' . $self->{name} . ' value: ' . scalar(@$values) . ' : ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});
my $i = 0 ;
my $escval ;
my $escopt ;
@@ -75,7 +75,7 @@ push @{$req -> {timing}}, ([.Time::HiRes:
local $escmode = 0 ;
print OUT $out ;

-push @{$req -> {timing}}, ([Time::HiRes::gettimeofday], 'end show_control ' . $self->{name} . ' ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});
+push @{$req -> {timing}}, ([Time::HiRes::gettimeofday()], 'end show_control ' . $self->{name} . ' ' . __FILE__ . '#' . __LINE__) if ($req -> {timing});

}


Modified: perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm Sun Oct 1 13:06:43 2023
@@ -88,7 +88,7 @@ sub show_control_addons

# ---------------------------------------------------------------------------

-sub get_doctypes_for_new
+sub get_doctypes_for_new_menu
{
my ($self, $req) = @_ ;

@@ -138,7 +138,7 @@ if ($datasrc)
$datasrc = $datasource -> datasource ;
if (!$self -> {no_new})
{
- $doctypes = $self -> get_doctypes_for_new ($req, $datasource) ;
+ $doctypes = $self -> get_doctypes_for_new_menu ($req, $datasource) ;
}

my ($constrain, $without_constrain) = $datasource -> get_constrain_value ($req, $self) ;

Modified: perl/embperl/trunk/Embperl/Form/Control/textarea.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/textarea.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/textarea.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/textarea.pm Sun Oct 1 13:06:43 2023
@@ -51,19 +51,94 @@ sub _filter_html

$$dataref =~ s/(<\/?(\w+).*?>)/ALLOWED_HTML_TAGS->{$2}?$1:''/ge ;
}
+
+# ------------------------------------------------------------------------------------------
+#
+# _text2html - convert plain text to html
+#
+
+sub _text2html
+ {
+ my ($self, $dataref) = @_ ;
+
+
+ my $is_html = $self -> {format} eq 'html' && ($$dataref =~ /^<[-a-zA-Z0-9 "'=:;,]+?>/) ;
+ return if ($is_html) ;
+
+ my @text = split (/\n/, $$dataref) ;
+
+ $$dataref = '<p>' . join ("<br>\n", @text) . "</p>\n" ;
+ }
+
+
+# ------------------------------------------------------------------------------------------
+#
+# _text2pre - convert plain text to html pre
+#
+
+sub _text2pre
+ {
+ my ($self, $dataref) = @_ ;
+
+
+ my $is_html = $self -> {format} eq 'html' && ($$dataref =~ /^<[-a-zA-Z0-9 "'=:;,]+?>/) ;
+ return if ($is_html) ;
+
+ $$dataref =~ s/<\/pre>/<_pre>/g ;
+ $$dataref = '<pre>' . $$dataref . "</pre>\n" ;
+ }
+

# ------------------------------------------------------------------------------------------
#
+# _html2text - convert html to plain text
+#
+
+sub _html2text
+ {
+ my ($self, $dataref) = @_ ;
+
+ return if ($self -> {format} ne 'html') ;
+
+ use utf8 ;
+ $$dataref =~ s/<.+?>/ /g ;
+ $$dataref =~ s/&auml;/ä/g ;
+ $$dataref =~ s/&ouml;/ö/g ;
+ $$dataref =~ s/&uuml;/ü/g ;
+ $$dataref =~ s/&Auml;/Ã?/g ;
+ $$dataref =~ s/&Ouml;/Ã?/g ;
+ $$dataref =~ s/&Uuml;/Ã?/g ;
+ $$dataref =~ s/&szlig;/Ã?/g ;
+ $$dataref =~ s/&gt;/>/g ;
+ $$dataref =~ s/&lt;/</g ;
+ $$dataref =~ s/&quot;/"/g ;
+ $$dataref =~ s/&apos;/'/g ;
+ $$dataref =~ s/&#39;/'/g ;
+ $$dataref =~ s/&amp;/&/g ;
+ $$dataref =~ s/&nbsp;/ /g ;
+ }
+
+# ------------------------------------------------------------------------------------------
+#
# get_display_text - returns the text that should be displayed
#

sub get_display_text
{
- my ($self, $req, $value) = @_ ;
+ my ($self, $req, $value, $compact) = @_ ;

$value = $self -> get_value ($req) if (!defined ($value)) ;
-
- $self -> _filter_html (\$value) if ($self -> {format} eq 'html') ;
+ return $value if ($self -> {format} ne 'html') ;
+
+ if ($compact)
+ {
+ $self -> _html2text (\$value) ;
+ }
+ else
+ {
+ $self -> _filter_html (\$value) ;
+ $self -> _text2html (\$value) ;
+ }

return $value ;
}
@@ -79,12 +154,25 @@ sub init_data
{
my ($self, $req, $parentctrl, $force) = @_ ;

- return if ($self -> {format} ne 'html') ;

my $fdat = $req -> {docdata} || \%fdat ;
my $name = $self->{name} ;
- $self -> _filter_html (\$fdat->{$name}) if (exists $fdat->{$name});
+ return if (!exists $fdat->{$name} || $req -> {"ef_textarea_init_done_$name"}) ;

+ if ($self -> {format} ne 'html')
+ {
+ if ($self -> is_readonly ($req))
+ {
+ $self -> _text2pre (\$fdat->{$name}) ;
+ }
+ }
+ else
+ {
+ $self -> _filter_html (\$fdat->{$name}) ;
+ $self -> _text2html (\$fdat->{$name}) ;
+ }
+
+ $req -> {"ef_textarea_init_done_$name"} = 1 ;
return ;
}

@@ -110,7 +198,19 @@ sub prepare_fdat
{
my ($self, $req) = @_ ;

- return $self -> init_data ($req) ;
+ my $fdat = $req -> {form} || \%Embperl::fdat ;
+ my $name = $self->{name} ;
+ return if (!exists $fdat->{$name}) ;
+
+ if ($self -> {format} ne 'html')
+ {
+ return ;
+ }
+
+ $self -> _filter_html (\$fdat->{$name}) ;
+ $self -> _text2html (\$fdat->{$name}) ;
+
+ return ;
}

1 ;
@@ -123,7 +223,6 @@ __EMBPERL__
#]

[$ sub show ($self, $req)
-
$]

[$if !$self -> {fullwidth} || $self -> is_readonly ($req) $]
@@ -135,7 +234,7 @@ $]
#]
<table class="ef-element ef-element-width-[+ $self -> {width_percent} +] ef-element-[+ $self -> {type} +] [+ $self -> {state} +]">
<tr>
- <td class="ef-label-box ef-label-box-width-full [$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]">
+ <td class="ef-label-box ef-label-box-width-full [$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]" _ef_attr="[+ $self -> {name} +]">
[.-
$fdat{$name} = $self -> {default} if ($fdat{$name} eq '' && exists ($self -> {default})) ;
my $span = 0 ;
@@ -163,9 +262,10 @@ $]
[.$ sub show_control ($self, $req)
my $class = $self -> {class} ||= '' ;
my ($attrs, $ctrlid, $name) = $self -> get_std_control_attr($req) ;
+my $ro = $self ->{no_edit} ? 'readOnly="1"' : '' ;
$]

-<textarea type="text" name="[+ $self -> {force_name} || $self -> {name} +]" [+ do { local $escmode = 0 ; $attrs} +]
+<textarea [+ $ro +] type="text" name="[+ $self -> {force_name} || $self -> {name} +]" [+ do { local $escmode = 0 ; $attrs} +]
[# [$if $self -> {cols} $]cols="[+ $self->{cols} +]"[$endif$] #]
[$if $self -> {rows} $]rows="[+ $self->{rows} +]"[$endif$]
[$if $self -> {format} eq 'html' $]_ef_attach="ef_ckeditor"[$endif$]

Modified: perl/embperl/trunk/Embperl/Form/DataSource.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/DataSource.pm?rev=1912655&r1=1912654&r2=1912655&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/DataSource.pm (original)
+++ perl/embperl/trunk/Embperl/Form/DataSource.pm Sun Oct 1 13:06:43 2023
@@ -11,8 +11,6 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id$
-#
###################################################################################

package Embperl::Form::DataSource ;
@@ -51,67 +49,67 @@ sub init
return $self ;
}

-# ---------------------------------------------------------------------------
-#
-# values_no_cache - returns true to inhibit cacheing of values during one request
-#
-
-sub values_no_cache { 0 }
-
-# ---------------------------------------------------------------------------
-#
-# constrain_attrs - returns attrs that might change the form layout
-# if there value changes
-#
-
-sub constrain_attrs
-
- {
- my ($self, $req) = @_ ;
-
- return () if (!$self -> {constrain}) ;
- return ($self -> {constrain}) ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# get_constrain_value - returns the constrain value that is need for a
-# search or undef if there is no constrain
-#
-# in $req request data
-# $ctrl control that will display the value
-# ret $constrain contrain value if any
-# $without_contrain true if also values that have no contrain value
-# are part of the resultset
-#
-
-sub get_constrain_value
-
- {
- my ($self, $req, $ctrl) = @_ ;
-
- return ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# get_url_modifier - returns modifier for url for requesting datasrc values (selectdyn)
-#
-# in $req request data
-# $ctrl control that will display the value
-# ret $search
-# $replace
-#
-
-sub get_url_modifier
-
- {
- my ($self, $req, $ctrl) = @_ ;
-
- return ;
- }
-
+# ---------------------------------------------------------------------------
+#
+# values_no_cache - returns true to inhibit cacheing of values during one request
+#
+
+sub values_no_cache { 0 }
+
+# ---------------------------------------------------------------------------
+#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return () if (!$self -> {constrain}) ;
+ return ($self -> {constrain}) ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_constrain_value - returns the constrain value that is need for a
+# search or undef if there is no constrain
+#
+# in $req request data
+# $ctrl control that will display the value
+# ret $constrain contrain value if any
+# $without_contrain true if also values that have no contrain value
+# are part of the resultset
+#
+
+sub get_constrain_value
+
+ {
+ my ($self, $req, $ctrl) = @_ ;
+
+ return ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# get_url_modifier - returns modifier for url for requesting datasrc values (selectdyn)
+#
+# in $req request data
+# $ctrl control that will display the value
+# ret $search
+# $replace
+#
+
+sub get_url_modifier
+
+ {
+ my ($self, $req, $ctrl) = @_ ;
+
+ return ;
+ }
+
# ---------------------------------------------------------------------------
#
# get_dbname - returns dbname to pass to control (selectdyn)
@@ -129,13 +127,13 @@ sub get_dbname
return ;
}

-# ---------------------------------------------------------------------------
-#
-# sorttype - returns information how to sort this datasource values for displaying
-#
-
-sub sorttype { undef }
-
+# ---------------------------------------------------------------------------
+#
+# sorttype - returns information how to sort this datasource values for displaying
+#
+
+sub sorttype { undef }
+
# ---------------------------------------------------------------------------
#
# get_values - returns the values and options
@@ -178,78 +176,78 @@ sub get_option_from_value
return ;
}

-# ---------------------------------------------------------------------------
-#
-# get_value_from_option - returns the value for a given option
-#
-# in $option option
-# ret value
-#
-
-sub get_value_from_option
-
- {
- my ($self, $option, $req, $ctrl) = @_ ;
-
-
- my ($values, $options) = $self -> get_values ($req, $ctrl) ;
-
- my $i = 0 ;
- foreach (@$options)
- {
- if ($_ eq $option)
- {
- return $values -> [$i] ;
- }
- $i++ ;
- }
-
- return ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# get_value_from_id - returns the value for a given id
-#
-# in $id id
-# ret value
-#
-
-sub get_value_from_id
-
- {
- my ($self, $option, $req, $ctrl) = @_ ;
-
- return ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# get_id_from_value - returns id for a given value
-#
-
-sub get_id_from_value
-
- {
- my ($self, $value, $req) = @_ ;
-
- return $value ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# get_datasource_controls - returns additional controls provided by the
-# datasource object e.g. a browse button
-#
-
-sub get_datasource_controls
-
- {
- my ($self, $req, $ctrl) = @_ ;
-
+# ---------------------------------------------------------------------------
+#
+# get_value_from_option - returns the value for a given option
+#
+# in $option option
+# ret value
+#
+
+sub get_value_from_option
+
+ {
+ my ($self, $option, $req, $ctrl) = @_ ;
+
+
+ my ($values, $options) = $self -> get_values ($req, $ctrl) ;
+
+ my $i = 0 ;
+ foreach (@$options)
+ {
+ if ($_ eq $option)
+ {
+ return $values -> [$i] ;
+ }
+ $i++ ;
+ }
+
+ return ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_value_from_id - returns the value for a given id
+#
+# in $id id
+# ret value
+#
+
+sub get_value_from_id
+
+ {
+ my ($self, $option, $req, $ctrl) = @_ ;
+
+ return ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# get_id_from_value - returns id for a given value
+#
+
+sub get_id_from_value
+
+ {
+ my ($self, $value, $req) = @_ ;
+
+ return $value ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_datasource_controls - returns additional controls provided by the
+# datasource object e.g. a browse button
+#
+
+sub get_datasource_controls
+
+ {
+ my ($self, $req, $ctrl) = @_ ;
+
return ;
- }
+ }


1 ;
@@ -280,13 +278,13 @@ that could be overwritten to customize t
=head2 get_values

returns the values and options. Must be overwritten.
-
-=head3 get_id_from_value
-
-returns an id for a given value. This allows one to have an id form a value/option
-pair which is not exactly the same as the value. This is used in json requests
+
+=head3 get_id_from_value
+
+returns an id for a given value. This allows one to have an id form a value/option
+pair which is not exactly the same as the value. This is used in json requests
for example for selectdyn control.
-
+
=head3 get_datasource_controls

returns additional controls provided by the



---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org