Author: richter Date: Tue Sep 11 03:52:22 2018 New Revision: 1840511 URL: http://svn.apache.org/viewvc?rev=1840511&view=rev Log: Enhancements Embperl::Form
Modified: perl/embperl/trunk/Embperl/Form.pm perl/embperl/trunk/Embperl/Form/Control.pm perl/embperl/trunk/Embperl/Form/Control/attachment.pm perl/embperl/trunk/Embperl/Form/Control/checkbox.pm perl/embperl/trunk/Embperl/Form/Control/datetime.pm perl/embperl/trunk/Embperl/Form/Control/display.pm perl/embperl/trunk/Embperl/Form/Control/dynlink.pm perl/embperl/trunk/Embperl/Form/Control/grid.pm perl/embperl/trunk/Embperl/Form/Control/mult.pm perl/embperl/trunk/Embperl/Form/Control/tabs.pm perl/embperl/trunk/Embperl/Form/Control/textarea.pm perl/embperl/trunk/Embperl/Form/ControlMultValue.pm perl/embperl/trunk/Embperl/Form/Validate.pm Modified: perl/embperl/trunk/Embperl/Form.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form.pm (original) +++ perl/embperl/trunk/Embperl/Form.pm Tue Sep 11 03:52:22 2018 @@ -90,6 +90,7 @@ sub sub_new $self -> {code_refs} = [] ; $self -> {constrain_attrs} = [] ; $self -> {do_validate} = [] ; + $self -> {all_controls} = {} ; } else { @@ -100,6 +101,7 @@ sub sub_new $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) { @@ -286,7 +288,7 @@ sub new_controls $control -> {type} ||= ($control -> {name}?'input':'blank') ; $control -> {parentid} = $id if ($id) ; $control -> {id} ||= $ctlid ; - $control -> {basename} = $control->{name} ; + $control -> {basename}||= $control->{name} ; $control -> {formid} = $formid ; $control -> {formptr} = $self -> {formptr} ; @@ -335,12 +337,14 @@ sub new_controls push @{$self -> {code_refs}}, $control ; weaken ($self -> {code_refs}[-1]) ; } - if ($control -> has_code_refs) + if ($control -> has_validate_rules) { push @{$self -> {do_validate}}, $control ; weaken ($self -> {do_validate}[-1]) ; } push @{$self -> {constrain_attrs}}, $control -> constrain_attrs ; + $self -> {all_controls}{$name} = $control ; + weaken ($self -> {all_controls}{$name}) ; } } $self -> {controlids}{$control->{id}} = $control ; Modified: perl/embperl/trunk/Embperl/Form/Control.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control.pm Tue Sep 11 03:52:22 2018 @@ -123,6 +123,8 @@ sub is_readonly { my ($self, $req) = @_ ; + return 0 if ($self -> {readonly} eq '0') ; + foreach my $readonly ($self -> {readonly}, $req -> {form_options_masks}{$self->{name}}{readonly}, $req -> {form_options_masks}{'*'}{readonly}) { return 1 if (ref ($readonly) eq 'CODE'?&{$readonly}($self, $req):$readonly) ; @@ -381,7 +383,7 @@ sub has_validate_rules my $auto = $self -> get_validate_auto_rules ($req) ; if ($auto) { - $self -> {validate} = $auto ; + #$self -> {validate} = $auto ; return scalar(@$auto) ; } @@ -461,7 +463,6 @@ sub get_display_text my ($self, $req, $value) = @_ ; $value = $self -> get_value ($req) if (!defined ($value)) ; - if (ref $value) { if (ref ($value) eq 'ARRAY') @@ -599,8 +600,8 @@ $style = 'white-space:nowrap; ' if ($sel $addclass = 'ef-label-box-width-' . ($self->{width_percent}) ; $addclass2 = 'ef-label-width-' . ($self->{width_percent}) ; $] - <td class="ef-label-box [+ $addclass +] [$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]" [$ if $style $]style="[+ $style +]"[$ endif $]> - <div class="ef-label [+ $addclass2 +]"> + <td class="ef-label-box [+ $addclass +] [$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]" [$ if $style $]style="[+ $style +]"[$ endif $]> + <div class="ef-label [+ $addclass2 +]" _ef_attr="[+ $self -> {name} +]"> [- $self -> show_label ($req); $self -> show_label_icon ($req) ; @@ -732,7 +733,7 @@ Do not display this control at all. Could value of this control be changed ? -=héad2 prepare_fdat +=h�ad2 prepare_fdat Is called when the form is submitted back. Can be used to convert the value that the user has entered in the form to the format that is used Modified: perl/embperl/trunk/Embperl/Form/Control/attachment.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/attachment.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/attachment.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/attachment.pm Tue Sep 11 03:52:22 2018 @@ -118,7 +118,7 @@ __EMBPERL__ my $name = $self -> {name}; $] -<div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +] _ef_attach="ef_attachment" _ef_dynid="<_id>" _ef_attr="[+ $name +]" _ef_always_download="[+ $self -> {always_download} +]" _ef_download_url_append="[+ $self -> {download_url_append} +]"> +<div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +] _ef_attach="ef_attachment" _ef_dynid="<_id>" _ef_attr="[+ $name +]" _ef_always_download="[+ $self -> {always_download} +]" _ef_download_url_append="[+ $self -> {download_url_append} +]" _ef_updattr="[+ $self -> {updattr} +]" _ef_type="[+ $self -> {renderer} +]"> [$if !$self -> {no_show} $]<a class="ef-attachment-show" href="#">Anzeigen</a> [$endif$] [$if !$self -> {no_download} $]<a class="ef-attachment-download" href="#">Download</a> [$endif$] [$if !$self -> {no_upload} $]<a class="ef-attachment-upload" href="#">Upload</a> [$endif$] @@ -138,7 +138,7 @@ $] my $name = $self -> {name}; $] -<div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +] _ef_attach="ef_attachment" _ef_dynid="<_id>" _ef_attr="[+ $name +]" _ef_always_download="[+ $self -> {always_download} +]"> +<div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +] _ef_attach="ef_attachment" _ef_dynid="<_id>" _ef_attr="[+ $name +]" _ef_always_download="[+ $self -> {always_download} +]" _ef_download_url_append="[+ $self -> {download_url_append} +]" _ef_type="[+ $self -> {renderer} +]"> [$if !$self -> {no_download} $]<a class="ef-attachment-download" href="#">Download</a> [$endif$] <input type="file" multiple style="display: none" name=[+ $name +]> <div _ef_divname="[+ $name +]" class="ef-attachment-info">[+ $fdat{$name} +]</div> @@ -179,8 +179,23 @@ Will be used as label for the control. =head3 no_delete +=head3 no_show + =head3 always_download +=head3 download_url_append + +=head3 renderer + +This value is passed as -type= parameter + +Default: attachment + +=head3 updattr + +If set <fieldname> in the url including download_url_append is replace by the content of +the given field in the same form + Modified: perl/embperl/trunk/Embperl/Form/Control/checkbox.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/checkbox.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/checkbox.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/checkbox.pm Tue Sep 11 03:52:22 2018 @@ -182,12 +182,20 @@ $] push @{$self -> form -> {fields2empty}}, $name ; $] <input type="checkbox" name="[+ $ctlname +]" [+ do { local $escmode = 0 ; $ctlattrs } +] value="[+ $val +]" -[$if ($self -> {trigger} || $self -> {button}) $]_ef_attach="ef_checkbox"[$endif$] +[$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 ($self -> {button}) $]<label for="[+ $ctlid +]"></label>[$endif$] [$endsub$] +[# --------------------------------------------------------------------------- +# +# show_control_addons - output additional things after the control +#] + +[$ sub show_control_addons ($self, $req) $][$if ($self -> {timer}) $]<span class='ui-icon ui-icon-clock ef-icon'></span>[$endif$][$endsub$] + + __END__ =pod Modified: perl/embperl/trunk/Embperl/Form/Control/datetime.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/datetime.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/datetime.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/datetime.pm Tue Sep 11 03:52:22 2018 @@ -21,9 +21,9 @@ use strict ; use base 'Embperl::Form::Control::number' ; use Embperl::Inline ; -use POSIX qw(strftime); -use Time::Local qw(timelocal_nocheck timegm_nocheck); -use Date::Calc qw{Delta_DHMS Add_Delta_Days} ; +use POSIX qw(strftime); +use Time::Local qw(timelocal_nocheck timegm_nocheck); +use Date::Calc qw{Delta_DHMS Add_Delta_Days} ; use vars qw{%fdat} ; @@ -46,60 +46,82 @@ sub init return $self ; } -# ------------------------------------------------------------------------------------------ -# -# get_display_text - returns the text that should be displayed -# - -sub get_display_text - { - my ($self, $req, $time) = @_ ; - - $time = $self -> get_value ($req) if (!defined ($time)) ; - - return $time if ($self -> {format} eq '-') ; - return if ($time eq '') ; - - if ($self -> {dynamic} && ($time =~ /^\s*((?:s|i|h|d|w|m|y|q)(?:\+|-)?(?:\d+)?)\s*$/)) - { - return $1 ; - } - - my ($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 @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' ; +# ------------------------------------------------------------------------------------------ +# +# get_display_text - returns the text that should be displayed +# + +sub get_display_text + { + my ($self, $req, $time) = @_ ; + + $time = $self -> get_value ($req) if (!defined ($time)) ; + + return $time if ($self -> {format} eq '-') ; + return if ($time eq '' && !exists $self -> {onempty}) ; + + if ($self -> {dynamic} && ($time =~ /^\s*((?:s|i|h|d|w|m|y|q)(?:\+|-)?(?:\d+)?)\s*$/)) + { + return $1 ; + } + + + my ($y, $m, $d, $h, $min, $s, $z) ; + + if ($self -> {onempty}) + { + ($s,$min,$h,$d,$m,$y) = localtime ; + $m++ ; + $y += 1900 ; + if ($self -> {onempty} eq 'b') + { + $h = $min = $s = 0 ; + } + elsif ($self -> {onempty} eq 'e') + { + $h = 23 ; + $min = 59 ; + $s = 59 ; + } + } + else + { + ($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 @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]) ; - } ; - - if ($time && !$date && ($time =~ /\d+\.\d+\.\d+/)) - { - $date = $time ; - } - - return $date ; - } - - -# ------------------------------------------------------------------------------------------ -# -# get_sort_value - returns the value that should be used to sort -# - -sub get_sort_value - { - my ($self, $req, $value) = @_ ; - - $value = $self -> get_value ($req) if (!defined ($value)) ; - return $value ; - } - + strftime ($format, @time[0..5]) ; + } ; + + if ($time && !$date && ($time =~ /\d+\.\d+\.\d+/)) + { + $date = $time ; + } + + return $date ; + } + + +# ------------------------------------------------------------------------------------------ +# +# get_sort_value - returns the value that should be used to sort +# + +sub get_sort_value + { + my ($self, $req, $value) = @_ ; + + $value = $self -> get_value ($req) if (!defined ($value)) ; + return $value ; + } + # ------------------------------------------------------------------------------------------ # # init_data - daten aufteilen @@ -108,67 +130,53 @@ sub get_sort_value sub init_data { my ($self, $req, $parentctrl, $force) = @_ ; - - my $fdat = $req -> {docdata} || \%fdat ; + + my $fdat = $req -> {docdata} || \%fdat ; my $name = $self->{name} ; my $time = $fdat->{$name} ; - return if ($time eq '' || $self -> {format} eq '-' || ($req -> {"ef_datetime_init_done_$name"} && !$force)) ; + 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) ; $req -> {"ef_datetime_init_done_$name"} = 1 ; } -# --------------------------------------------------------------------------- -# -# init_markup - add any dynamic markup to the form data -# - -sub init_markup - - { - my ($self, $req, $parentctl, $method) = @_ ; - - return if (!$self -> is_readonly($req) && (! $parentctl || ! $parentctl -> is_readonly($req))) ; - - return $self -> init_data ($req, $parentctl) ; - } - -# ------------------------------------------------------------------------------------------ +# --------------------------------------------------------------------------- # -# prepare_fdat - daten zusammenfuehren +# init_markup - add any dynamic markup to the form data # -sub prepare_fdat +sub init_markup + { - my ($self, $req) = @_ ; - - return if ($self -> is_readonly ($req) || $self -> {format} eq '-') ; - - my $fdat = $req -> {form} || \%fdat ; - my $name = $self->{name} ; - return if (!exists $fdat->{$name}) ; - my $date = $fdat -> {$name} ; - return if ($date eq '') ; + my ($self, $req, $parentctl, $method) = @_ ; - if ($self -> {dynamic} && ($date =~ /^\s*((?:s|i|h|d|w|m|y|q)\s*(?:\+|-)?\s*(?:\d+)?)\s*$/)) - { - $fdat->{$name} = $1 ; - $fdat->{$name} =~ s/\s//g ; - return ; - } - + return if (!$self -> is_readonly($req) && (! $parentctl || ! $parentctl -> is_readonly($req))) ; - my ($year, $mon, $day, $hour, $min, $sec) ; + return $self -> init_data ($req, $parentctl) ; + } + + +# --------------------------------------------------------------------------- +# +# str2time +# + +sub str2time + + { + my ($date) = @_ ; + + my ($year, $mon, $day, $hour, $min, $sec) ; if ($date eq '*' || $date eq '.') - { - my $offset ||= 0 ; - ($sec, $min, $hour, $day, $mon, $year) = gmtime (time + $offset) ; - $year += 1900 ; - $mon++ ; - } - else - { - $date =~ tr/,;/ / ; + { + my $offset ||= 0 ; + ($sec, $min, $hour, $day, $mon, $year) = gmtime (time + $offset) ; + $year += 1900 ; + $mon++ ; + } + else + { + $date =~ tr/,;/ / ; my ($d, $t) = split (/\s+/, $date) ; if ($d =~ /:/) { @@ -177,7 +185,7 @@ sub prepare_fdat } ($day, $mon, $year) = map { $_ + 0 } split (/\./, $d) ; ($hour, $min, $sec) = map { $_ + 0 } split (/\:/, $t) ; - + if ($year == 0 || $mon == 0 || $day == 0) { my ($s, $min, $h, $md, $m, $y) = localtime ; @@ -205,7 +213,36 @@ sub prepare_fdat 0, 0, -$tz_local, 0) if ($hour || $min || $sec) ; } - $fdat -> {$name} = $year?sprintf ('%04d%02d%02d%02d%02d%02dZ', $year, $mon, $day, $hour, $min, $sec):'' ; + return $year?sprintf ('%04d%02d%02d%02d%02d%02dZ', $year, $mon, $day, $hour, $min, $sec):'' ; + } + + +# ------------------------------------------------------------------------------------------ +# +# prepare_fdat - daten zusammenfuehren +# + +sub prepare_fdat + { + my ($self, $req) = @_ ; + + return if ($self -> is_readonly ($req) || $self -> {format} eq '-') ; + + my $fdat = $req -> {form} || \%fdat ; + my $name = $self->{name} ; + return if (!exists $fdat->{$name}) ; + 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*$/)) + { + $fdat->{$name} = $1 ; + $fdat->{$name} =~ s/\s//g ; + return ; + } + + + $fdat -> {$name} = str2time ($date) ; } # --------------------------------------------------------------------------- @@ -240,10 +277,10 @@ $] <input type="text" name="[+ $self -> {force_name} || $self -> {name} +]" [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req, $fullid) } +] [$if $self -> {size} $]size="[+ $self->{size} +]"[$endif$] -[$if $self -> {maxlength} $]maxlength="[+ $self->{maxlength} +]"[$endif$] +[$if $self -> {maxlength} $]maxlength="[+ $self->{maxlength} +]"[$endif$] _ef_attach="ef_datetime" _ef_dynamic="[+ $self -> {dynamic}?'true':'' +]" > -[# +[# <script type="text/javascript"> $('#[+ $fullid +]').datepicker ({ showWeek: true, [$if $self -> {dynamic} $]constrainInput: false, [$endif$] Modified: perl/embperl/trunk/Embperl/Form/Control/display.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/display.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/display.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/display.pm Tue Sep 11 03:52:22 2018 @@ -21,6 +21,7 @@ use strict ; use base 'Embperl::Form::Control' ; use Embperl::Inline ; +use HTML::Escape ; use vars qw{%fdat} ; @@ -70,6 +71,21 @@ sub init_data $fdat->{$name} = join ("<br>\n", @$value) ; } } + +# --------------------------------------------------------------------------- +# +# init_markup - add any dynamic markup to the form data +# + +sub init_markup + + { + my ($self, $req, $parentctl, $method) = @_ ; + + my $fdat = $req -> {docdata} || \%fdat ; + my $name = $self->{name} ; + $fdat->{$name} = HTML::Escape::escape_html ($fdat->{$name}) ; + } # ------------------------------------------------------------------------------------------ Modified: perl/embperl/trunk/Embperl/Form/Control/dynlink.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/dynlink.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/dynlink.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/dynlink.pm Tue Sep 11 03:52:22 2018 @@ -59,6 +59,7 @@ $] _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$] [+ do { local $escmode = 0 ; $self -> {eventattrs} } +]> Modified: perl/embperl/trunk/Embperl/Form/Control/grid.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/grid.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/grid.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/grid.pm Tue Sep 11 03:52:22 2018 @@ -556,10 +556,12 @@ $] [$if !($self -> is_readonly ($req)) && !$self -> {disable_controls} $] <td class="cBase cGridControlBox"> <div> - <span class="ui-icon ui-icon-circle-triangle-n ef-icon ef-control-grid-up" title="Zeile Hoch"></span> - <span class="ui-icon ui-icon-circle-triangle-s ef-icon ef-control-grid-down" title="Zeile Runter"></span> - <span class="ui-icon ui-icon-circle-plus ef-icon ef-control-grid-add" title="Zeile Hinzufügen"></span> - <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-grid-del" title="Markierte Zeile Löschen"></span> + <span class="ui-icon ui-icon-circle-triangle-n ef-icon ef-control-grid-up" title="[= ctl:grid_up =]"></span> + <span class="ui-icon ui-icon-circle-triangle-s ef-icon ef-control-grid-down" title="[= ctl:grid_down =]"></span> + <span class="ui-icon ui-icon-circle-plus ef-icon ef-control-grid-add" title="[= ctl:grid_add =]"></span> + <span class="ui-icon ui-icon-circle-arrow-e ef-icon ef-control-grid-insert" title="[= ctl:grid_insert =]"></span> + <span class="ui-icon ui-icon-circle-arrow-s ef-icon ef-control-grid-copy" title="[= ctl:grid_copy =]"></span> + <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-grid-del" title="[= ctl:grid_del =]"></span> </div> </td> [$endif$] @@ -588,7 +590,7 @@ $] [# --------------------------------------------------------------------------- # -# show_grid_footer Erzeugt den Tabellenfuß (Summenzeile) +# show_grid_footer Erzeugt den Tabellenfu� (Summenzeile) #] [$ sub show_grid_footer ($self, $req) Modified: perl/embperl/trunk/Embperl/Form/Control/mult.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/mult.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/mult.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/mult.pm Tue Sep 11 03:52:22 2018 @@ -325,8 +325,8 @@ $] $] [$if (! $self -> is_readonly ($req)) $] - <span class="ui-icon ui-icon-circle-plus ef-icon ef-control-mult-add" title="Zeile Hinzufügen"></span> - <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-mult-del" title="Zeile Löschen"></span> + <span class="ui-icon ui-icon-circle-plus ef-icon ef-control-mult-add" title="[= ctl:grid_add =]"></span> + <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-mult-del" title="[= ctl:grid_del =]"></span> [$endif$] [$endsub$] Modified: perl/embperl/trunk/Embperl/Form/Control/tabs.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/tabs.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/tabs.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/tabs.pm Tue Sep 11 03:52:22 2018 @@ -112,7 +112,9 @@ $] > [$if (!$form -> {noframe}) $] - <div class="ef-tabs-separator ui-accordion-header ui-helper-reset ui-state-default ui-accordion-icons ui-corner-top"><span class="ui-accordion-header-icon ui-icon ui-icon-triangle-1-s ef-icon" title="Verstecken/Anzeigen"></span><span class="ef-tabs-separator-header-text">[+ $form -> {text} +]</span></div> + [$if !$self -> is_disabled ($req) $] + <div class="ef-tabs-separator ui-accordion-header ui-helper-reset ui-state-default ui-accordion-icons ui-corner-top"><span class="ui-accordion-header-icon ui-icon ui-icon-triangle-1-s ef-icon" title="[+ $form -> convert_text ({}, 'ctl:show_hide', 'Verstecken/Anzeigen', $req) +]"></span><span class="ef-tabs-separator-header-text">[+ $form -> convert_text ({}, 'tab:' . $form->{id}, $from -> {text}, $req) +]</span></div> + [$endif$] [#<table class="ef-tabs-border-cell [+ $class +]"><tr><td class="ef-tabs-content-cell"> #] <div class="ef-tabs-border-cell [+ $class +]"><div class="ef-tabs-content-cell"> @@ -179,6 +181,16 @@ $] my $id = $self -> {subids}[$j] ; my $cellclass = $id eq $activeid?'ef-tabs-cell-on':'ef-tabs-cell-off' ; my $divclass = $id eq $activeid?'ef-tabs-div-on':'ef-tabs-div-off' ; + if ($i - $start_i == 0) + { + $cellclass .= ' ef-tabs-cell-left' ; + $divclass .= ' ef-tabs-div-left' ; + } + elsif ($i - $start_i == -1 || $j == @$values - 1) + { + $cellclass .= ' ef-tabs-cell-right' ; + $divclass .= ' ef-tabs-div-right' ; + } my @switch_code ; @@ -190,7 +202,7 @@ $] my $js = join (';', @switch_code) ; *] <td class="[+ $cellclass +]"><div class="ef-tabs-div [+ $divclass +]" - [$ if $i - $start_i == 0 $]style="border-left: black 1px solid" [$endif$] +[# [$ if $i - $start_i == 0 $]style="border-left: black 1px solid" [$endif$] #] >[+ $options ->[$j] || $val +] </div></td> [* $i++ ; Modified: perl/embperl/trunk/Embperl/Form/Control/textarea.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/textarea.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/textarea.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/textarea.pm Tue Sep 11 03:52:22 2018 @@ -185,7 +185,7 @@ my $text = $self -> get_display_text ($ $text =~ s/\s*$// ; $text =~ s/^\s*// ; my $name = $self -> {force_name} || $self -> {name} ; -my $is_html = $self -> {format} eq 'html' && ($text =~ /^<[a-zA-Z0-9 "'=:-;,]+?>/) ; +my $is_html = $self -> {format} eq 'html' && ($text =~ /^<[-a-zA-Z0-9 "'=:;,]+?>/) ; my @text = $is_html?($text):split (/\n/, $text) ; $] <div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req, '', 'readonly') } +] _ef_divname="[+ $name +]"> Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original) +++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Tue Sep 11 03:52:22 2018 @@ -62,7 +62,7 @@ sub constrain_attrs my ($self, $req) = @_ ; return if (!$self -> {datasrcobj}) ; - + return $self -> {datasrcobj} -> constrain_attrs ($req) ; } @@ -86,7 +86,7 @@ sub get_all_values my $values ; my $options ; my $nocache = 0 ; - + if ($self -> {datasrcobj}) { my $key = "all_values_datasrc:$self->{datasrcobj}" ; @@ -104,25 +104,25 @@ sub get_all_values } else { - $values = $self -> {values} ; + $values = $self -> {values} ; $options = $self -> {options} || $values ; $options = $self -> form -> convert_options ($self, $self -> {values}, $options, $req) if (!$self -> {showoptions} && $self -> form) ; } - + if (!$addtop && !$addbottom) { $req -> {$key} = [$values, $options] ; - return ($values, $options) + return ($values, $options) } my @values ; - my @options ; + my @options ; if ($addtop) { push @values, map { ref $_?$_ -> [0]:$_ } @$addtop ; push @options, map { ref $_?$_ -> [1]:$_ } @$addtop ; } - + if ($values) { if ($addtop && $values -> [0] eq '' && $options -> [0] eq '---') @@ -136,7 +136,7 @@ sub get_all_values push @options, @$options ; } } - + if ($addbottom) { push @values, map { $_ -> [0] } @$addbottom ; @@ -157,7 +157,7 @@ sub get_values { my ($self, $req) = @_ ; - + my ($values, $options) = $self -> get_all_values ($req) ; my $filter = $self -> {filter} ; return ($values, $options) if (!$filter) ; @@ -176,7 +176,7 @@ sub get_values } return (\@values, \@options) ; } - + # --------------------------------------------------------------------------- # @@ -204,18 +204,18 @@ sub get_id_from_value my ($self, $value, $req) = @_ ; return if (!$self -> {datasrcobj}) ; - + if (wantarray) { $value = [$value] if (!ref $value) ; - my @result ; + my @result ; foreach my $val (@$value) { - push @result, $self -> {datasrcobj} -> get_id_from_value ($val, $req) ; + push @result, $self -> {datasrcobj} -> get_id_from_value ($val, $req) ; } - return @result ; + return @result ; } - + $value = $value -> [0] if (ref $value) ; return $self -> {datasrcobj} -> get_id_from_value ($value, $req) ; } @@ -234,10 +234,10 @@ sub get_dbname my ($self, $req, $ctrl) = @_ ; return if (!$self -> {datasrcobj}) ; - + return $self -> {datasrcobj} -> get_dbname ($req, $self) ; } - + # --------------------------------------------------------------------------- # @@ -251,7 +251,7 @@ sub get_option_from_value { my ($self, $value, $req) = @_ ; - + my $addtop = $self -> {addtop} ; if ($addtop) { @@ -262,12 +262,12 @@ sub get_option_from_value return $_ -> [1] ; } } - } + } if ($self->{datasrc}) { my $option = $self -> {datasrcobj} -> get_option_from_value ($value, $req, $self) ; - + return $option if (defined ($option)) ; } elsif (ref $self -> {values}) @@ -296,7 +296,7 @@ sub get_option_from_value return $_ -> [1] ; } } - } + } return ; } @@ -313,7 +313,7 @@ sub get_value_from_option { my ($self, $option, $req) = @_ ; - + my $addtop = $self -> {addtop} ; if ($addtop) { @@ -324,18 +324,18 @@ sub get_value_from_option return $_ -> [0] ; } } - } + } if ($self->{datasrc}) { my $value = $self -> {datasrcobj} -> get_value_from_option ($option, $req, $self) ; - + return $value if (defined ($value)) ; } elsif (ref $self -> {options}) { my $i = 0 ; - my $options = $self -> {options} ; + my $options = $self -> {options} ; $options = $self -> form -> convert_options ($self, $self -> {options}, $options, $req) if (!$self -> {showoptions}) ; foreach (@$options) @@ -358,7 +358,7 @@ sub get_value_from_option return $_ -> [0] ; } } - } + } return ; } @@ -375,11 +375,11 @@ sub get_value_from_id { my ($self, $id, $req) = @_ ; - + if ($self->{datasrc}) { my $value = $self -> {datasrcobj} -> get_value_from_id ($id, $req, $self) ; - + return $value if (defined ($value)) ; } @@ -431,7 +431,7 @@ sub is_with_id return 1 ; } - + # ------------------------------------------------------------------------------------------ # # get_display_text - returns the text that should be displayed @@ -440,7 +440,7 @@ sub is_with_id sub get_display_text { my ($self, $req, $value) = @_ ; - + $value = $self -> get_value ($req) if (!defined ($value)) ; if (!ref $value) { @@ -455,7 +455,7 @@ sub get_display_text return join (', ', @result) ; } - + # ------------------------------------------------------------------------------------------ # # get_sort_value - returns the value that should be used to sort @@ -464,16 +464,16 @@ sub get_display_text sub get_sort_value { my ($self, $req, $value) = @_ ; - + if ($self -> {datasrcobj} && $self -> {datasrcobj} -> can('get_sort_value')) { $value = $self -> get_value ($req) if (!defined ($value)) ; - return $self -> {datasrcobj} -> get_sort_value ($req, $value) ; + return $self -> {datasrcobj} -> get_sort_value ($req, $value) ; } return $self -> SUPER::get_sort_value ($req, $value) ; } - + # --------------------------------------------------------------------------- # # init_markup - add any dynamic markup to the form data @@ -485,7 +485,7 @@ sub init_markup my ($self, $req, $parentctl, $method) = @_ ; return if (!$self -> is_readonly($req) && (! $parentctl || ! $parentctl -> is_readonly($req))) ; - + my $val = $self -> get_value ($req) ; if ($val ne '') { @@ -519,20 +519,20 @@ sub prepare_fdat } elsif ($fdat -> {$name} eq '') { - $fdat -> {$name} = $self -> get_value_from_option ($fdat -> {"_opt_$name"}, $req) ; + $fdat -> {$name} = $self -> get_value_from_option ($fdat -> {"_opt_$name"}, $req) ; } - } + } elsif (exists ($fdat -> {"_id_$name"})) { - if ($fdat -> {$name} eq '') + if ($fdat -> {$name} eq '' && $fdat -> {"_id_$name"} ne '') { - $fdat -> {$name} = $self -> get_value_from_id ($fdat -> {"_id_$name"}, $req) ; + $fdat -> {$name} = $self -> get_value_from_id ($fdat -> {"_id_$name"}, $req) ; } } delete $fdat -> {"_opt_$name"} ; delete $fdat -> {"_id_$name"} ; } - + 1 ; # damit %fdat etc definiert ist @@ -544,10 +544,10 @@ __EMBPERL__ # show_control_readonly - output the control as readonly #] -[$ sub show_control_readonly ($self, $req, $value) +[$ sub show_control_readonly ($self, $req, $value) my $text = $self -> get_display_text ($req, $value) ; -my $id = $self -> get_id_from_value ($val, $req) ; +my $id = $self -> get_id_from_value ($val, $req) ; my $name = $self -> {force_name} || $self -> {name} ; $] <div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req, '', 'readonly', 'ef-control-with-id') } +] _ef_divname="_opt_[+ $name +]">[+ $text +]</div> @@ -565,7 +565,7 @@ $] #] [$ sub show_control_addons ($self, $req) - + my $datasrc_ctrls ; $datasrc_ctrls = $self -> get_datasource_controls ($req) unless ($self -> {no_datasource_controls}) ; @@ -646,4 +646,3 @@ G. Richter (richter at embperl dot org) =head1 SEE ALSO perl(1), Embperl, Embperl::Form, Embperl::From::Control, Embperl::Form::DataSource - Modified: perl/embperl/trunk/Embperl/Form/Validate.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate.pm?rev=1840511&r1=1840510&r2=1840511&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate.pm Tue Sep 11 03:52:22 2018 @@ -270,7 +270,8 @@ sub validate_rules my $name ; my $msg ; my $break = 0 ; - + my @key_stack ; + while ($i < @$frules) { my $action = $frules -> [$i++] ; @@ -299,6 +300,20 @@ sub validate_rules $name = undef ; $msg = undef ; } + elsif ($1 eq 'key_check') + { + push @key_stack, $key ; + $key = $frules->[$i++] ; + $keys = ref $key?$key:[$key] ; + $type = 'Default' ; + $typeobj = $self -> newtype ($type) ; + $break = 1 ; + } + elsif ($1 eq 'key_end') + { + $key = pop @key_stack ; + $break = 0 ; + } elsif ($1 eq 'name') { $name = $i++ ; @@ -509,6 +524,7 @@ sub gather_script_code my $script = '' ; my $form = $self -> {form_id} ; my $break = 0 ; + my @key_stack ; while ($i < @$frules) { @@ -534,6 +550,20 @@ sub gather_script_code $name = undef ; $msg = undef ; } + elsif ($1 eq 'key_check') + { + push @key_stack, $key ; + $key = $frules->[$i++] ; + $keys = ref $key?$key:[$key] ; + $type = 'Default' ; + $typeobj = $self -> newtype ($type) ; + $break = 1 ; + } + elsif ($1 eq 'key_end') + { + $key = pop @key_stack ; + $break = 0 ; + } elsif ($1 eq 'name') { $name = $i++ ; @@ -771,6 +801,10 @@ is normally the name given in the HTML n C<-key> can also be a arrayref, in which case B<only one of> the given keys must statisfy the following test to succeed. +=item -key_break + +same as -key and -break => 1 without reseting name -name and -msg. + =item -name is a human readable name that should be used in error messages. Can be --------------------------------------------------------------------- To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org For additional commands, e-mail: embperl-cvs-h...@perl.apache.org