Mailing List Archive

Author: richter
Date: Tue Jan 21 10:46:39 2014
New Revision: 1559969

URL: http://svn.apache.org/r1559969
Log:
Embperl::Form dynamic fingerprints

Modified:
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Control.pm
perl/embperl/trunk/Embperl/Form/Control/display.pm
perl/embperl/trunk/Embperl/Form/Control/grid.pm
perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
perl/embperl/trunk/Embperl/Form/DataSource.pm

Modified: perl/embperl/trunk/Embperl/Form.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Tue Jan 21 10:46:39 2014
@@ -86,6 +86,7 @@ sub sub_new
$self -> {init_markup} = [] ;
$self -> {prepare_fdat} = [] ;
$self -> {code_refs} = [] ;
+ $self -> {constrain_attrs} = [] ;
$self -> {do_validate} = [] ;
}
else
@@ -94,6 +95,7 @@ sub sub_new
$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 -> {constrain_attrs} = $self -> parent_form -> {constrain_attrs} ;
$self -> {code_refs} = $self -> parent_form -> {code_refs} ;
$self -> {do_validate} = $self -> parent_form -> {do_validate} ;
}
@@ -313,6 +315,7 @@ sub new_controls
push @{$self -> {prepare_fdat}}, $control if ($control -> can ('prepare_fdat')) ;
push @{$self -> {code_refs}}, $control if ($control -> has_code_refs) ;
push @{$self -> {do_validate}}, $control if ($control -> has_validate_rules) ;
+ push @{$self -> {constrain_attrs}}, $control -> constrain_attrs ;
}
}
$self -> {controlids}{$control->{id}} = $control ;
@@ -736,6 +739,21 @@ sub all_code_ref_fingerprints
return $fp ;
}

+# ---------------------------------------------------------------------------
+#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return $self -> {constrain_attrs} ;
+ }
+
+
# ---------------------------------------------------------------------------
#
# validate - validate the form input

Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Tue Jan 21 10:46:39 2014
@@ -89,7 +89,23 @@ sub is_disabled

my $disable = $self -> {disable} || $req -> {form_options_masks}{$self->{name}}{disable} || $req -> {form_options_masks}{'*'}{disable} ;
$disable = &{$disable}($self, $req) if (ref ($disable) eq 'CODE') ;
-
+
+ return $disable ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# is_blanked - display this control as blank field
+#
+
+sub is_blanked
+
+ {
+ my ($self, $req) = @_ ;
+
+ my $disable = $self -> {blank} || $req -> {form_options_masks}{$self->{name}}{blank} || $req -> {form_options_masks}{'*'}{blank} ;
+ $disable = &{$disable}($self, $req) if (ref ($disable) eq 'CODE') ;
+
return $disable ;
}

@@ -145,7 +161,7 @@ sub has_code_refs
{
my ($self, $req) = @_ ;

- return ref ($self -> {readonly}) eq 'CODE' || ref ($self -> {disable}) eq 'CODE' ;
+ return ref ($self -> {readonly}) eq 'CODE' || ref ($self -> {disable}) eq 'CODE' || ref ($self -> {blank}) eq 'CODE' ;
}


@@ -159,9 +175,22 @@ sub code_ref_fingerprint
{
my ($self, $req) = @_ ;

- return ($self -> is_readonly($req)?'R':'W') . ($self -> is_disabled($req)?'D':'E') ;
+ return ($self -> is_readonly($req)?'R':'W') . ($self -> is_disabled($req)?'D':'E') . ($self -> is_blanked($req)?'B':'S') ;
}

+# ---------------------------------------------------------------------------
+#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return () ;
+ }

# ---------------------------------------------------------------------------
#
@@ -452,10 +481,12 @@ my $span = 0 ;

$]<table class="ef-element ef-element-width-[+ $self -> {width_percent} +] ef-element-[+ $self -> {type} +] [+ $self -> {state} +]">
<tr>
- [-
+ [$ if ($self -> is_blanked ($req)) $]
+ <td class="ef-label-box ef-label-box-width-100"> </td>
+ [$else$][.-
$span += $self -> show_label_cell ($req, $span);
$self -> show_control_cell ($req, $span) ;
- -]
+ -][$endif$]
</tr>
</table>[$
endsub $]
@@ -602,8 +633,8 @@ sub show_control_readonly_array
$]
<td class="ef-control-box [+ $addclass +]">
[.*
- my @ret = $ro?$self -> show_control_readonly_array($req):$self -> show_control ($req);
- $self -> show_control_addons ($req) ;
+ my @ret = $ro?$self -> show_control_readonly_array($req):$self -> show_control ($req);
+ $self -> show_control_addons ($req) ;
*]
</td>
[* return @ret ; *]

Modified: perl/embperl/trunk/Embperl/Form/Control/display.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/display.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/display.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/display.pm Tue Jan 21 10:46:39 2014
@@ -22,6 +22,50 @@ use base 'Embperl::Form::Control' ;

use Embperl::Inline ;

+use vars qw{%fdat} ;
+
+
+# ------------------------------------------------------------------------------------------
+#
+# init_data - daten aufteilen
+#
+
+sub init_data
+ {
+ my ($self, $req, $parentctrl) = @_ ;
+
+ return if (!$self -> {value2text}) ;
+
+
+ my $fdat = $req -> {docdata} || \%fdat ;
+ my $name = $self->{name} ;
+ my $value = $fdat->{$name} ;
+
+ my $val ;
+ my $txt ;
+ if (ref $value eq 'ARRAY')
+ {
+ foreach (@$value)
+ {
+ $val = $self -> {value2text} . $_ ;
+ $txt = $self -> form -> convert_text ($self, $val, undef, $req) ;
+ $_ = $txt if ($txt ne $val) ;
+ }
+ }
+ else
+ {
+ $val = $self -> {value2text} . $value ;
+ $txt = $self -> form -> convert_text ($self, $val, undef, $req) ;
+ $fdat->{$name} = $txt if ($txt ne $val) ;
+ }
+ }
+
+# ------------------------------------------------------------------------------------------
+
+
+sub show_control_readonly { $_[0] -> show_control ($_[1], $_[2]) }
+
+
1 ;

__EMBPERL__
@@ -31,11 +75,10 @@ __EMBPERL__
# show_control - output the control
#]

-[.$ sub show_control ($self, $req)
-
+[.$ sub show_control ($self, $req, $value)
my $name = $self->{name};
my $id = $self->{id};
-my $value = exists $self->{value} ? $self->{value} : $fdat{$name};
+$value = exists $self->{value} ? $self->{value} : $fdat{$name} if (!defined ($value)) ;
$value = [ split /\t/, $value ] if $self->{split};
$value = [ split /\n/, $value ] if $self->{splitlines};

@@ -108,6 +151,11 @@ on a new line.
Splits the value into an array at \n if set and displays every array element
on a new line.

+=head3 value2text
+
+Will run the value prefixed with the given paramenter through convert_text,
+so it can be translated.
+
=head1 Author

G. Richter (richter at embperl dot org), A. Beckert (beckert@ecos.de)

Modified: perl/embperl/trunk/Embperl/Form/Control/grid.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/grid.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/grid.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/grid.pm Tue Jan 21 10:46:39 2014
@@ -85,6 +85,44 @@ sub init
return $self ;
}

+
+
+# ------------------------------------------------------------------------------------------
+#
+# init_data_hash
+#
+
+sub init_data_hash
+ {
+ my ($rowno, $fdat, $name, $fields) = @_ ;
+
+ my $data ;
+ map
+ {
+ $data = $fdat->{$name}{$_} ;
+ my @data ;
+ if (ref $data eq 'HASH')
+ {
+ $data -> {'_key'} = $_ ;
+ foreach (@$fields)
+ {
+ push @data, $data -> {$_ -> {name}} ;
+ }
+ }
+ elsif (ref $data eq 'ARRAY')
+ {
+ push @data, $_, @$data ;
+ }
+ else
+ {
+ push @data, $_, $data ;
+ }
+
+ [$rowno++, @data ]
+ } keys %{$fdat->{$name}} ;
+
+ }
+
# ------------------------------------------------------------------------------------------
#
# init_data - daten aufteilen
@@ -98,10 +136,10 @@ sub init_data
my $ldap = $req->{ldap};
my $name = $self->{name} ;
my $rowno = 1 ;
+ my $fields = $self -> {fields} ;
my @entries = ref $fdat->{$name} eq 'ARRAY'?@{$fdat->{$name}}:
- ref $fdat->{$name} eq 'HASH' ?map { [$rowno++, $_ => $fdat->{$name}{$_}] } keys %{$fdat->{$name}}:
+ ref $fdat->{$name} eq 'HASH' ?init_data_hash ($rowno, $fdat, $name, $fields):
split("\t",$fdat->{$name});
- my $fields = $self -> {fields} ;
my $line2 = $self -> {line2} ;
my $order = $self -> {order} ;
my $order_desc = $self -> {order_desc} ;
@@ -117,12 +155,10 @@ sub init_data
$i++ ;
}
}
-
+::dbg($order, \@entries) ;
if ($order_desc)
{
- @entries = sort {
- #print STRERR "$b->[$order] cmp $a->[$order]\n" ;
- $b -> [$order] cmp $a -> [$order] } @entries ;
+ @entries = sort { $b -> [$order] cmp $a -> [$order] } @entries ;
}
else
{

Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Tue Jan 21 10:46:39 2014
@@ -51,6 +51,22 @@ sub init

# ---------------------------------------------------------------------------
#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return if (!$self -> {datasrcobj}) ;
+
+ return $self -> {datasrcobj} -> constrain_attrs ($req) ;
+ }
+
+# ---------------------------------------------------------------------------
+#
# get_all_values - returns all values and options, including addtop and addbottom
#


Modified: perl/embperl/trunk/Embperl/Form/DataSource.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/DataSource.pm?rev=1559969&r1=1559968&r2=1559969&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/DataSource.pm (original)
+++ perl/embperl/trunk/Embperl/Form/DataSource.pm Tue Jan 21 10:46:39 2014
@@ -60,6 +60,21 @@ sub values_no_cache { 0 }

# ---------------------------------------------------------------------------
#
+# constrain_attrs - returns attrs that might change the form layout
+# if there value changes
+#
+
+sub constrain_attrs
+
+ {
+ my ($self, $req) = @_ ;
+
+ return () if (!$self -> {constrain}) ;
+ return ($self -> {constrain}) ;
+ }
+
+# ---------------------------------------------------------------------------
+#
# sorttype - returns information how to sort this datasource values for displaying
#




---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org