Mailing List Archive

svn commit: r1465235 - in /perl/embperl/trunk/Embperl: Form.pm Form/Control.pm Form/Control/checkbox.pm Form/Control/dynctrl.pm Form/Control/grid.pm Form/ControlMultValue.pm
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-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org