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-unsubscr...@perl.apache.org
For additional commands, e-mail: embperl-cvs-h...@perl.apache.org

Reply via email to