Author: richter
Date: Sat Apr  6 12:53:05 2013
New Revision: 1465235

URL: http://svn.apache.org/r1465235
Log:
Embperl::Form

Modified:
    perl/embperl/trunk/Embperl/Form.pm
    perl/embperl/trunk/Embperl/Form/Control.pm
    perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
    perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm
    perl/embperl/trunk/Embperl/Form/Control/grid.pm
    perl/embperl/trunk/Embperl/Form/ControlMultValue.pm

Modified: perl/embperl/trunk/Embperl/Form.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Sat Apr  6 12:53:05 2013
@@ -87,14 +87,16 @@ sub sub_new
     if ($toplevel)
         {
         $self -> {fields2empty} = [] ;
-        $self -> {init_data}    = [] ;
+        $self -> {init_data}    = [] ;
+        $self -> {init_markup}  = [] ;
         $self -> {prepare_fdat} = [] ;
         $self -> {code_refs}    = [] ;
         }
     else
         {
         $self -> {fields2empty} = $self -> parent_form -> {fields2empty} ;
-        $self -> {init_data}    = $self -> parent_form -> {init_data} ;
+        $self -> {init_data}    = $self -> parent_form -> {init_data} ;
+        $self -> {init_markup}  = $self -> parent_form -> {init_markup} ;
         $self -> {prepare_fdat} = $self -> parent_form -> {prepare_fdat} ;
         $self -> {code_refs}    = $self -> parent_form -> {code_refs} ;
         }
@@ -314,7 +316,8 @@ sub new_controls
             $control = $self -> new_object ($packages, $type, $control) ;
             if (!$no_init)
                 {
-                push @{$self -> {init_data}}, $control if ($control -> can 
('init_data')) ;
+                push @{$self -> {init_data}}, $control if ($control -> can 
('init_data')) ;
+                push @{$self -> {init_markup}}, $control if ($control -> can 
('init_markup')) ;
                 push @{$self -> {prepare_fdat}}, $control if ($control -> can 
('prepare_fdat')) ;
                 push @{$self -> {code_refs}}, $control if ($control -> 
has_code_refs) ;
                 }
@@ -577,22 +580,38 @@ sub show
     }
 
 
-# ---------------------------------------------------------------------------
-#
-#   init_data - init fdat before showing
-#
-
-sub init_data
-
-    {
-    my ($self, $req) = @_ ;
-
-    foreach my $control (@{$self -> {init_data}})
-        {
-        $control -> init_data ($req) ;
-        }
-    }
-
+# ---------------------------------------------------------------------------
+#
+#   init_data - init fdat before showing
+#
+
+sub init_data
+
+    {
+    my ($self, $req) = @_ ;
+
+    foreach my $control (@{$self -> {init_data}})
+        {
+        $control -> init_data ($req) ;
+        }
+    }
+
+# ---------------------------------------------------------------------------
+#
+#   init_markup - add any dynamic markup to the form data
+#
+
+sub init_markup
+
+    {
+    my ($self, $req, $grid, $method) = @_ ;
+
+    foreach my $control (@{$self -> {init_markup}})
+        {
+        $control -> init_markup ($req, $grid, $method) ;
+        }
+    }
+
 # ---------------------------------------------------------------------------
 #
 #   prepare_fdat - change fdat after submit

Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Sat Apr  6 12:53:05 2013
@@ -324,6 +324,7 @@ sub get_value
     my $fdat       = $req -> {docdata} || \%Embperl::fdat ;
     my $name       = $self -> {name} ;
     my $dataprefix = $self -> {dataprefix} ;
+
     return $fdat -> {$name} if (!$dataprefix) ;
     
     foreach my $prefix (@$dataprefix)

Modified: perl/embperl/trunk/Embperl/Form/Control/checkbox.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/checkbox.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/checkbox.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/checkbox.pm Sat Apr  6 12:53:05 2013
@@ -52,6 +52,25 @@ sub has_auto_label_size
     return 0 ;
     }
 
+# 
------------------------------------------------------------------------------------------
+#
+#   init_data - daten aufteilen
+#
+
+sub init_data
+    {
+    my ($self, $req, $grid) = @_ ;
+    
+    return if (!$self -> is_readonly() && (!$grid || !$grid -> is_readonly())) 
;
+    
+    my $val = $self -> get_value ($req) ;
+    my $value      = $self -> {value} ;
+    $value = 1 if ($value eq '') ;
+    my $fdat       = $req -> {docdata} || \%Embperl::fdat ;
+::dbg($val, $self->{value}) ;    
+    $fdat -> {"_opt_$self->{name}"} = $value eq $val?'X':'-' ;
+    }
+
 # ---------------------------------------------------------------------------
 #
 #   show_control_readonly - output readonly control
@@ -65,6 +84,7 @@ sub show_control_readonly
     my $val      = $self -> {value} ;
     $val = 1 if ($val eq '') ;
 
+    $self -> {force_name} = '_opt_' . $self -> {name} ;
     $self -> SUPER::show_control_readonly ($req, $fdat{$name} eq $val?'X':'-') 
;
     }
 

Modified: perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/dynctrl.pm Sat Apr  6 12:53:05 2013
@@ -31,9 +31,11 @@ sub create_ctrl
     {
     my ($self, $req) = @_ ;
     
-    my $fdat = ($req -> {form} && keys (%{$req -> {form}}) > 0)?$req -> 
{form}:\%Embperl::fdat ;
+    my $fdat = ($req -> {form} && keys (%{$req -> {form}}) > 0)?$req -> 
{form}:$req -> {docdata} || \%Embperl::fdat ;
     my $id   = $self -> {id} . $self -> {name} ;
-    #::dbg('create_control id = ', $id, ' name = ', $self -> {name}, ' value = 
', $fdat -> {$self -> {name}}) ; #, $req -> {form}, \%Embperl::fdat, $fdat) ;   
 
+    #::dbg('create_control id = ', $id, ' name = ', $self -> {name}, ' value = 
', $fdat -> {$self -> {name}}, $fdat) ;
+    #$req -> {form}, \%Embperl::fdat, $fdat, $req -> {docdata}, $req) ;
+    #Carp::cluck ('cc') ;
     return $req -> {"dynctrl_$id"} if ($req -> {"dynctrl_$id"}) ;
     
     my $ctrl  ;
@@ -44,7 +46,7 @@ sub create_ctrl
         }
     else
         {
-        my $ctrl = {} ;
+        $ctrl = {} ;
         foreach my $f (keys %$ctrlattr)
             {
             my $val = $ctrlattr -> {$f} ;
@@ -56,7 +58,6 @@ sub create_ctrl
             $ctrl -> {$f} = $val ;
             }
         }
-
     foreach my $attr (keys %$self)
         {
         $ctrl -> {$attr} = $self -> {$attr} 
@@ -70,7 +71,8 @@ sub create_ctrl
                }
     $ctrl -> {text} = $ctrl -> {textprefix} . $ctrl -> {text} if ($ctrl -> 
{textprefix}) ;
     my $form = $self -> form ;
-    my $ctrlform = [$ctrl] ;
+    my $ctrlform = [$ctrl] ;
+::dbg($self->{name}, $ctrlform) ;    
     $form -> new_controls ($ctrlform, undef, undef, undef, undef, undef, 
undef, 1) ;
 
     return $req -> {"dynctrl_$id"} = $ctrlform -> [0] ;
@@ -78,31 +80,35 @@ sub create_ctrl
     
 # ----------------------------------------------------------------------------
 
-sub show 
-    {
-    my $self = shift ;
-    my $ctrl = $self -> create_ctrl ($_[0]) ;
-    $ctrl -> show (@_) if ($ctrl) ;
-    }
-
-# ----------------------------------------------------------------------------
-
-sub show_control 
+sub init_markup 
     {
-    my $self = shift ;
-    my $ctrl = $self -> create_ctrl ($_[0]) ;
-    $ctrl -> show_control (@_) if ($ctrl) ;
+    my ($self, $req, $grid, $method) = @_ ;
+    my $ctrl = $self -> create_ctrl ($req) ;
+    return  if (!$ctrl) ;
+    my $name = $self -> {name} ;
+    my $fdat  = $req -> {docdata} || \%Embperl::fdat ;
+    
+    my $output ;
+    my @errors ;
+    $method ||= 'show' ;
+    
+    my $src = '$param[1] -> ' . $method . ' ($param[2])' ;
+    my $rc = Embperl::Execute ({ inputfile => 'dynctrl' . $method,
+                    input => \$src,
+                    mtime => 1,
+                    syntax => 'Perl',
+                    param => [$self, $ctrl, $req],
+                    output => \$output,
+                    errors => \@errors,
+                    options => 262144,
+                  }) ;
+    die \@errors if ($rc) ;
+    
+    #::dbg($ctrl, $output) ;
+    $fdat -> {'_ctl_' . $name} = $output ;
     }
 
-
-# ----------------------------------------------------------------------------
-
-sub show_readonly
-    {
-    my $self = shift ;
-    my $ctrl = $self -> create_ctrl ($_[0]) ;
-    $ctrl -> show_readonly (@_) if ($ctrl) ;
-    }
+
 
 # ----------------------------------------------------------------------------
 
@@ -129,6 +135,51 @@ sub prepare_fdat 
 
 __EMBPERL__
 
+[# ---------------------------------------------------------------------------
+#
+#   show - output the whole control including the label
+#]
+
+[$sub show ($self, $req) 
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[- $ctrl -> show 
($req) if ($ctrl) -]</div>[$ endsub $]
+
+[# ---------------------------------------------------------------------------
+#
+#   show_control
+#]
+
+[$sub show_control ($self, $req) 
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+::dbg($name, $req -> {dynctrl_in_show}) ;
+if ($req -> {dynctrl_in_show})
+    {
+    return $ctrl -> show_control ($req) ;    
+    }
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[- $ctrl -> 
show_control ($req) if ($ctrl) -]</div>[$ endsub $]
+
+[# ---------------------------------------------------------------------------
+#
+#   show_control
+#]
+
+[$sub show_control_readonly ($self, $req, $value) 
+
+my $ctrl = $self -> create_ctrl ($req) ;
+my $name = $self -> {name} ;
+if ($req -> {dynctrl_in_show})
+    {
+    return $ctrl -> show_control_readonly ($req, $value) ;    
+    }
+local $req -> {dynctrl_in_show} = 1 ;
+$]<div style="display: inline" _ef_divname="_ctl_[+$name+]">[- $ctrl -> 
show_control_readonly ($req, $value) if ($ctrl) -]</div>[$ endsub $]
+
 
 __END__
 

Modified: perl/embperl/trunk/Embperl/Form/Control/grid.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/grid.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/grid.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/grid.pm Sat Apr  6 12:53:05 2013
@@ -154,6 +154,7 @@ sub init_data
                 {
                 local $field->{name} = "__${name}_${j}_$i" ;
                 local $field -> {fullid} = "$self->{fullid}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 $field -> init_data ($req, $self)  ;
                 }
             $j++ ;    
@@ -166,6 +167,40 @@ sub init_data
 
 # 
------------------------------------------------------------------------------------------
 #
+#   init_markup
+#
+
+sub init_markup
+    {
+    my ($self, $req, $grid, $method) = @_ ;
+    
+    my $fdat  = $req -> {docdata} || \%fdat ;
+    my $name    = $self->{name} ;
+    my $i ;
+    my $j ;
+    my $max = $fdat->{"__${name}_max"} ;
+    my $fields  = $self -> {fields} ;
+    my $line2   = $self -> {line2} ;
+
+    for ($i = 0; $i <= $max; $i++)
+        {
+        $j = 0 ;
+        foreach my $field ((@$fields, ($line2?($line2):())))
+            {
+            if ($field -> can ('init_markup'))
+                {
+                local $field->{name} = "__${name}_${j}_$i" ;
+                local $field -> {fullid} = "$self->{fullid}_${j}_$i" ;
+                local $field->{dataprefix} ;
+                $field -> init_markup ($req, $self, 'show_control')  ;
+                }
+            $j++ ;    
+            }
+        }
+    }
+
+# 
------------------------------------------------------------------------------------------
+#
 #   prepare_fdat_sub - wird aufgerufen nachdem die einzelen Controls 
abgearbeitet sind abd
 #                   bevor die daten zusammenfuehrt werden
 #
@@ -214,6 +249,7 @@ sub prepare_fdat
                 {
                 local $field->{name} = "__${name}_${j}_$i" ;
                 local $field -> {fullid} = "$self->{fullid}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 $field -> prepare_fdat ($req)  ;
                 }
             $ok++ ;
@@ -426,8 +462,9 @@ $]
             [* next if ($field -> is_hidden ) ; *]
             <td class="cGridFooter cGridCellReadonly">[-
                 local $field -> {name}  = "__${name}_${j}_$i" ;
-                local $field -> {state} = $self -> {state} ;
+                local $field -> {state} = $field -> {state} . ' ' . $self -> 
{state} ;
                 local $field -> {fullid} = "$self->{fullid}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 $field -> show_control_readonly ($req) if (!$field -> 
{nofooter}) ; 
                 $j++ ;
                 -]</td>
@@ -459,6 +496,7 @@ $]
                 local $field -> {name}  = "__${name}_${j}_$i" ;
                 local $field -> {state} = $self -> {state} ;
                 local $field -> {fullid} = "${id}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 $field -> show_control ($req) ;
                 $j++ ;
             -][$else$]
@@ -467,6 +505,7 @@ $]
                 local $field -> {name}  = "__${name}_${j}_$i" ;
                 local $field -> {state} = $self -> {state} ;
                 local $field -> {fullid} = "${id}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 if ($ro)
                     {
                     $field -> show_control_readonly ($req)
@@ -489,6 +528,7 @@ $]
                 local $line2 -> {name}  = "__${name}_${j}_$i" ;
                 local $line2 -> {state} = $self -> {state} ;
                 local $field -> {fullid} = "${id}_${j}_$i" ;
+                local $field->{dataprefix} ;
                 if ($ro)
                     {
                     $line2 -> show_control_readonly ($req)

Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
URL: 
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=1465235&r1=1465234&r2=1465235&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Sat Apr  6 12:53:05 2013
@@ -272,6 +272,25 @@ sub get_active_id
     return $req -> {$key} = $activeid ;
     }
 
+# 
------------------------------------------------------------------------------------------
+#
+#   init_data - daten aufteilen
+#
+
+sub init_data
+    {
+    my ($self, $req, $grid) = @_ ;
+    
+    return if (!$self -> is_readonly() && (!$grid || !$grid -> is_readonly())) 
;
+    
+    my $val = $self -> get_value ($req) ;
+    if ($val ne '')
+        {
+        my $fdat       = $req -> {docdata} || \%Embperl::fdat ;
+        $fdat -> {"_opt_$self->{name}"} = $self -> get_option_from_value 
($val, $req) ;
+        }
+    }
+    
 # ---------------------------------------------------------------------------
 #
 #   show_control_readonly - output readonly control
@@ -286,6 +305,7 @@ sub show_control_readonly
     
     $option = '<Kein Zugriff>' if (!$option && $value && 
($req->{userCtx}{role} ne '*')) ; 
     
+    $self -> {force_name} = '_opt_' . $self -> {name} ;
     $self -> SUPER::show_control_readonly ($req, $option) ;
     }
 



---------------------------------------------------------------------
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