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> -[$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 (j...@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/ä/ä/g ; + $$dataref =~ s/ö/ö/g ; + $$dataref =~ s/ü/ü/g ; + $$dataref =~ s/Ä/Ã/g ; + $$dataref =~ s/Ö/Ã/g ; + $$dataref =~ s/Ü/Ã/g ; + $$dataref =~ s/ß/Ã/g ; + $$dataref =~ s/>/>/g ; + $$dataref =~ s/</</g ; + $$dataref =~ s/"/"/g ; + $$dataref =~ s/'/'/g ; + $$dataref =~ s/'/'/g ; + $$dataref =~ s/&/&/g ; + $$dataref =~ s/ / /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-unsubscr...@perl.apache.org For additional commands, e-mail: embperl-cvs-h...@perl.apache.org