Mailing List Archive

svn commit: r1840511 - in /perl/embperl/trunk/Embperl: ./ Form/ Form/Control/
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>&nbsp;[$endif$]
[$if !$self -> {no_download} $]<a class="ef-attachment-download" href="#">Download</a>&nbsp;[$endif$]
[$if !$self -> {no_upload} $]<a class="ef-attachment-upload" href="#">Upload</a>&nbsp;[$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>&nbsp;[$endif$]
<input type="file" multiple style="display: none" name=[+ $name +]>&nbsp;
<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&uuml;gen"></span>
- <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-grid-del" title="Markierte Zeile L&ouml;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&uuml;gen"></span>
- <span class="ui-icon ui-icon-circle-minus ef-icon ef-control-mult-del" title="Zeile L&ouml;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-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org