You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2011/09/05 07:34:10 UTC
svn commit: r1165172 - in /perl/embperl/trunk/Embperl: Form.pm
Form/Control.pm Form/Control/grid.pm Form/Control/radio.pm
Form/Control/select.pm Form/Control/selectdyn.pm Form/Control/textarea.pm
Form/ControlMultValue.pm Form/DataSource.pm
Author: richter
Date: Mon Sep 5 05:34:09 2011
New Revision: 1165172
URL: http://svn.apache.org/viewvc?rev=1165172&view=rev
Log:
Enhancements DataSource and Grid
Modified:
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Control.pm
perl/embperl/trunk/Embperl/Form/Control/grid.pm
perl/embperl/trunk/Embperl/Form/Control/radio.pm
perl/embperl/trunk/Embperl/Form/Control/select.pm
perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm
perl/embperl/trunk/Embperl/Form/Control/textarea.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=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Mon Sep 5 05:34:09 2011
@@ -253,7 +253,7 @@ sub new_object
sub new_controls
{
- my ($self, $controls, $options, $id, $formid, $validate_rules, $masks, $defaults) = @_ ;
+ my ($self, $controls, $options, $id, $formid, $validate_rules, $masks, $defaults, $no_init) = @_ ;
my $n = 0 ;
my $packages = $self -> get_control_packages ;
@@ -293,9 +293,11 @@ sub new_controls
{
my $type = $control -> {type} || ($control -> {name}?'input':'blank') ;
$control = $self -> new_object ($packages, $type, $control) ;
- push @{$self -> {init_data}}, $control if ($control -> can ('init_data')) ;
- push @{$self -> {prepare_fdat}}, $control if ($control -> can ('prepare_fdat')) ;
-
+ if (!$no_init)
+ {
+ push @{$self -> {init_data}}, $control if ($control -> can ('init_data')) ;
+ push @{$self -> {prepare_fdat}}, $control if ($control -> can ('prepare_fdat')) ;
+ }
}
$self -> {controlids}{$control->{id}} = $control ;
@@ -308,7 +310,7 @@ sub new_controls
foreach my $subcontrols (@{$control -> {sublines}})
{
next if (!$subcontrols) ;
- $self -> new_controls ($subcontrols, $options, "$name-$i", $formid, $validate_rules, $masks, $defaults) ;
+ $self -> new_controls ($subcontrols, $options, "$name-$i", $formid, $validate_rules, $masks, $defaults, $no_init) ;
$i++ ;
}
}
Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Mon Sep 5 05:34:09 2011
@@ -240,6 +240,31 @@ sub has_auto_label_size
return 1 ;
}
+
+# ---------------------------------------------------------------------------
+#
+# get_value - return the current value for the control
+# if dataprefix is set, every hash key within dataprefix is tried
+#
+
+sub get_value
+ {
+ my ($self, $req) = @_ ;
+
+ my $fdat = $req -> {docdata} || \%Embperl::fdat ;
+ my $name = $self -> {name} ;
+ my $dataprefix = $self -> {dataprefix} ;
+ return $fdat -> {$name} if (!$dataprefix) ;
+
+ foreach my $prefix (@$dataprefix)
+ {
+ my $item = $prefix?$fdat -> {$prefix}{$name}:$fdat -> {$name} ;
+ return $item if (defined ($item)) ;
+ }
+
+ return ;
+ }
+
1 ;
# ===========================================================================
Modified: perl/embperl/trunk/Embperl/Form/Control/grid.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/grid.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/grid.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/grid.pm Mon Sep 5 05:34:09 2011
@@ -58,8 +58,14 @@ sub init
my $form = $self -> form ;
my $options = $form -> {options} ;
my $validate_rules = $self -> {validate_rules} = [] ;
- $form -> new_controls ($self -> {fields}, $options, undef, undef, $validate_rules, $options -> {masks}, $options -> {defaults}) ;
-
+ $form -> new_controls ($self -> {fields}, $options, undef, undef, $validate_rules, $options -> {masks}, $options -> {defaults}, 1) ;
+ if ($self -> {line2})
+ {
+ my $ctl = [$self -> {line2}] ;
+ $form -> new_controls ($ctl, $options, undef, undef, $validate_rules, $options -> {masks}, $options -> {defaults}, 1) ;
+ $self -> {line2} = $ctl -> [0] ;
+ }
+
return $self ;
}
@@ -77,20 +83,43 @@ sub init_data
my $name = $self->{name} ;
my @entries = ref $fdat->{$name} eq 'ARRAY'?@{$fdat->{$name}}:split("\t",$fdat->{$name});
my $fields = $self -> {fields} ;
+ my $line2 = $self -> {line2} ;
+ my $order = $self -> {order} ;
+ my $order_desc = $self -> {order_desc} ;
+ if ($order)
+ {
+ if ($order_desc)
+ {
+ @entries = sort { print STRERR "$b->[$order] cmp $a->[$order]\n" ; $b -> [$order] cmp $a -> [$order] } @entries ;
+ }
+ else
+ {
+ @entries = sort { $a -> [$order] cmp $b -> [$order] } @entries ;
+ }
+ }
+
my $data;
my $i = 0 ;
my $j ;
my $col ;
+ my $colval ;
foreach my $entry (@entries)
{
$data = ref $entry eq 'ARRAY'?$entry:[$ldap?ecos::LdapBase -> splitAttrValue($entry):$entry];
my $rowno = shift @$data ;
$j = 0 ;
- foreach my $field (@$fields)
+ foreach my $field ((@$fields, ($line2?($line2):())))
{
$col = exists $field -> {col}?$field -> {col}:$j ;
- $fdat->{"__${name}_${j}_$i"} = $data->[$col] ;
+ if ($colval = $field -> {colval})
+ {
+ $fdat->{"__${name}_${j}_$i"} = $data->[$col] =~ /\Q$colval\E/?1:0 ;
+ }
+ else
+ {
+ $fdat->{"__${name}_${j}_$i"} = $data->[$col] ;
+ }
if ($field -> can ('init_data'))
{
local $field->{name} = "__${name}_${j}_$i" ;
@@ -130,6 +159,7 @@ sub prepare_fdat
my $ldap = $req->{ldap};
my $name = $self->{name} ;
my $fields = $self -> {fields} ;
+ my $line2 = $self -> {line2} ;
my $max = $fdat->{"__${name}_max"} ;
my @rows;
@@ -137,13 +167,14 @@ sub prepare_fdat
my $i ;
my $val ;
my $col ;
+ my $colval ;
my %orders ;
my $order ;
for (my $i = 0; $i < $max; $i++)
{
my $ok = 0 ;
my $j = 0 ;
- foreach my $field (@$fields)
+ foreach my $field (@$fields, $line2?($line2):())
{
if ((ref ($field) =~ /::/) && $field -> can ('prepare_fdat'))
{
@@ -172,7 +203,14 @@ sub prepare_fdat
foreach my $field (@$fields)
{
$col = exists $field -> {col}?$field -> {col}:$j ;
- $data[$col+1] = $fdat->{"__${name}_${j}_$i"} ;
+ if ($colval = $field -> {colval})
+ {
+ $data[$col+1] .= $colval if ($fdat->{"__${name}_${j}_$i"}) ;
+ }
+ else
+ {
+ $data[$col+1] = $fdat->{"__${name}_${j}_$i"} ;
+ }
$j++ ;
}
$val = $ldap?ecos::LdapBase -> joinAttrValue(\@data):\@data ;
@@ -282,6 +320,7 @@ $]
[$ sub show_grid_table_row ($self, $req, $i)
my $fields = $self -> {fields} ;
+ my $line2 = $self -> {line2} ;
my $id = $self -> {id};
my $name = $self -> {name} ;
my $n = 0 ;
@@ -307,6 +346,23 @@ $]
-]</td>
[$endforeach$]
</tr>
+ [$if $line2 $]
+ <tr class="cGridRow2" id="[+ "$id-row2-$i" +]">
+ [- $ro = $gridro || $line2 -> is_readonly ; -]
+ <td colspan="[+ scalar(@$fields) +]" class="[+ $ro?'cGridCellReadonly':'cGridCell' +]">[$if $n++ == 0$]<input type="hidden" name="[+ "__${name}_#row#_$i" +]" value="[+ $i +]">[$endif$][-
+ local $line2 -> {name} = "__${name}_${j}_$i" ;
+ if ($ro)
+ {
+ $line2 -> show_control_readonly ($req)
+ }
+ else
+ {
+ $line2 -> show_control ($req)
+ }
+ $j++ ;
+ -]</td>
+ </tr>
+ [$endif$]
[$ endsub $]
[# ---------------------------------------------------------------------------
@@ -367,11 +423,21 @@ The following extra attributes are avail
Column number inside the @data array, which should be used for this cell
+=item colval
+
+If given this value is added to the column. This allows to have multiple
+checkboxes all writing to the same column, each appending a character or
+string if set.
+
=back
+=head3 line2
+
+field defintion wich is show in a second line, full width.
+
=head3 on_grid_change
-JavaScrip function that is called whan grid changes (i.e. add row, delete row etc.)
+JavaScript function that is called whan grid changes (i.e. add row, delete row etc.)
=head3 header_bottom
@@ -380,6 +446,15 @@ a header line is also displayed at the b
grid. Default is 10. Set to -1 to always get a
header at the bottom.
+=head3 order
+
+Column to use as sort key
+
+=head3 order_desc
+
+Sort descending
+
+
=head2 Example
{
Modified: perl/embperl/trunk/Embperl/Form/Control/radio.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/radio.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/radio.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/radio.pm Mon Sep 5 05:34:09 2011
@@ -22,39 +22,6 @@ use base 'Embperl::Form::ControlMultValu
use Embperl::Inline ;
-# ---------------------------------------------------------------------------
-#
-# show_control_readonly - output readonly control
-#
-
-sub show_control_readonly
- {
- my ($self, $req) = @_ ;
-
- my ($values, $options) = $self -> get_values ($req) ;
- my $name = $self -> {name} ;
- my $addtop = $self -> {addtop} || [] ;
- my $addbottom= $self -> {addbottom} || [] ;
- my $set = !defined ($fdat{$name})?1:0 ;
- my $filter = $self -> {filter} ;
-
- my $val ;
- my $i = 0 ;
-
- if ($set)
- {
- foreach $val ((@$addtop, @$values, @$addbottom))
- {
- if (!defined ($filter) || (ref $val?$val -> [0]:$val =~ /$filter/i))
- {
- $fdat{$name} = ref $val?$val -> [0]:$val ;
- last ;
- }
- }
- }
-
- $self -> show_control ($req, "^\Q$fdat{$name}\E\$", $values, $options) ;
- }
# ---------------------------------------------------------------------------
@@ -77,9 +44,6 @@ __EMBPERL__
($values, $options) = $self -> get_values ($req) if (!$values) ;
my $name = $self -> {name} ;
- $filter ||= $self -> {filter} ;
- my $addtop = $self -> {addtop} || [] ;
- my $addbottom= $self -> {addbottom} || [] ;
my $ignorecase= $self -> {ignorecase} ;
my $max = @$values ;
my $set = !defined ($fdat{$name})?1:0 ;
@@ -105,30 +69,14 @@ else
$]
<table class="cRadioTab[+ $self -> is_readonly?' cControlReadonly':''+]">[+ do { local $escmode = 0 ; $trglob }+]
-[$ foreach $val (@$addtop) $]
- [$if !defined ($filter) || ($val->[0] =~ /$filter/i) $]
- [- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -]
- [+ do { local $escmode = 0 ; $tr }+]<td><input type="radio" name="[+ $name +]" value="[+ $val -> [0] +]"
- ></td><td>[+ $val ->[1] || $val -> [0] +]</td>[+ do { local $escmode = 0 ; $trend }+]
- [$endif$]
-[$endforeach$]
[$ foreach $val (@$values) $][- $x = ($val =~ /$filter/i) -]
- [$if !defined ($filter) || ($val =~ /$filter/i) $]
[- $fdat{$name} = $val, $set = 0 if ($set) ;
$fdat{$name} = $val if ($ignorecase && lc($fdat{$name}) eq lc($val)) ; -]
[+ do { local $escmode = 0 ; $tr }+]<td><input type="radio" name="[+ $name +]" value="[+ $val +]" id="[+ "$name-_-$val" +]"
[$if ($self -> {sublines} || $self -> {subobjects}) $] OnClick="[+ $nsprefix +]show_radio_checked(document, this,[+ $i +],[+ $max +])" [$endif$]
></td><td>[+ $options ->[$i] || $val +]</td>[+ do { local $escmode = 0 ; $trend }+]
- [$endif$]
[* $i++ ; *]
[$endforeach$]
-[$ foreach $val (@$addbottom) $]
- [$if !defined ($filter) || ($val->[0] =~ /$filter/i) $]
- [- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -]
- [+ do { local $escmode = 0 ; $tr }+]<td><input type="radio" name="[+ $name +]" value="[+ $val -> [0] +]"
- ></td><td>[+ $val ->[1] || $val -> [0] +]</td>[+ do { local $escmode = 0 ; $trend }+]
- [$endif$]
-[$endforeach$]
[+ do { local $escmode = 0 ; $trendglob }+]</table>
[$endsub$]
Modified: perl/embperl/trunk/Embperl/Form/Control/select.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/select.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/select.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/select.pm Mon Sep 5 05:34:09 2011
@@ -51,7 +51,7 @@ sub get_select_values
# show_control_readonly - output readonly control
#
-sub show_control_readonly
+sub xshow_control_readonly
{
my ($self, $req) = @_ ;
Modified: perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/selectdyn.pm Mon Sep 5 05:34:09 2011
@@ -27,7 +27,7 @@ use Embperl::Inline ;
# show_control_readonly - output readonly control
#
-sub show_control_readonly
+sub xshow_control_readonly
{
my ($self, $req) = @_ ;
Modified: perl/embperl/trunk/Embperl/Form/Control/textarea.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/textarea.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/textarea.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/textarea.pm Mon Sep 5 05:34:09 2011
@@ -39,6 +39,20 @@ __EMBPERL__
></textarea>
[$endsub$]
+
+[# ---------------------------------------------------------------------------
+#
+# show_control_readonly - output the control as readonly
+#]
+
+[$ sub show_control_readonly ($self, $req, $value, $class) $]
+[-
+$value //= $fdat{$self -> {name}} ;
+@value = split (/\n/, $value) ;
+-][$ foreach my $val (@value) $]
+[- $self -> SUPER::show_control_readonly ($req, $val, $class) -]<br>
+[$endforeach$]
+[$endsub$]
__END__
=pod
Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Mon Sep 5 05:34:09 2011
@@ -49,22 +49,88 @@ sub init
# ---------------------------------------------------------------------------
#
-# get_values - returns the values and options
+# get_all_values - returns all values and options, including addtop and addbottom
#
-sub get_values
+sub get_all_values
{
my ($self, $req) = @_ ;
- return $self -> {datasrcobj} -> get_values ($req, $self) if ($self -> {datasrcobj}) ;
+ my $addtop = $self -> {addtop} ;
+ my $addbottom = $self -> {addbottom} ;
+
+ my $values ;
+ my $options ;
+
+ if ($self -> {datasrcobj})
+ {
+ ($values, $options) = $self -> {datasrcobj} -> get_values ($req, $self) ;
+ $options ||= $values ;
+ }
+ else
+ {
+ $values = $self -> {values} ;
+ $options = $self -> {options} || $values ;
+ $options = $self -> form -> convert_options ($self, $self -> {values}, $options)
+ if (!$self -> {showoptions}) ;
+ }
+
+ return ($values, $options) if (!$addtop && !$addbottom) ;
+
+ my @values ;
+ my @options ;
+ if ($addtop)
+ {
+ push @values, map { $_ -> [0] } @$addtop ;
+ push @options, map { $_ -> [0] } @$addtop ;
+ }
+
+ if ($values)
+ {
+ push @values, @$values ;
+ push @options, @$options ;
+ }
+
+ if ($addbottom)
+ {
+ push @values, map { $_ -> [0] } @$addbottom ;
+ push @options, map { $_ -> [0] } @$addbottom ;
+ }
+
+ return (\@values, \@options) ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_values - returns values and options, possibly filter applied
+#
+
+sub get_values
- my $options = $self -> {options} ;
- $options = $self -> form -> convert_options ($self, $self -> {values}, $options)
- if (!$self -> {showoptions}) ;
+ {
+ my ($self, $req) = @_ ;
- return ($self -> {values}, $options) ;
+
+ my ($values, $options) = $self -> get_all_values ($req) ;
+ my $filter = $self -> {filter} ;
+ return ($values, $options) if (!$filter) ;
+
+ my @values ;
+ my @options ;
+ my $i = 0 ;
+ foreach (@$values)
+ {
+ if (/$filter/)
+ {
+ push @values, $_ ;
+ push @options, $options -> [$i] ;
+ }
+ $i++ ;
+ }
+ return (\@values, \@options) ;
}
+
# ---------------------------------------------------------------------------
#
@@ -94,6 +160,49 @@ sub get_id_from_value
return $self -> {datasrcobj} -> get_id_from_value ($value) ;
}
+# ---------------------------------------------------------------------------
+#
+# get_option_form_value - returns the option for a given value
+#
+# in $value value
+# ret option
+#
+
+sub get_option_from_value
+
+ {
+ my ($self, $value, $req) = @_ ;
+
+ my $addtop = $self -> {addtop} ;
+ if ($addtop)
+ {
+ foreach (@$addtop)
+ {
+ if ($_ -> [0] eq $value)
+ {
+ return $_ -> [1] ;
+ }
+ }
+ }
+
+ my $option = $self -> {datasrcobj} -> get_option_from_value ($value, $req, $self) ;
+
+ return $option if (defined ($option)) ;
+
+ my $addbottom = $self -> {addbottom} ;
+ if ($addbottom)
+ {
+ foreach (@$addbottom)
+ {
+ if ($_ -> [0] eq $value)
+ {
+ return $_ -> [1] ;
+ }
+ }
+ }
+
+ return ;
+ }
# ---------------------------------------------------------------------------
#
@@ -124,6 +233,20 @@ sub get_active_id
return $activeid ;
}
+# ---------------------------------------------------------------------------
+#
+# show_control_readonly - output readonly control
+#
+
+sub show_control_readonly
+ {
+ my ($self, $req) = @_ ;
+
+ my $value = $self -> get_value ($req) ;
+ my $option = $self -> get_option_from_value ($value, $req) ;
+ $self -> SUPER::show_control_readonly ($req, $option) ;
+ }
+
1 ;
Modified: perl/embperl/trunk/Embperl/Form/DataSource.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/DataSource.pm?rev=1165172&r1=1165171&r2=1165172&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/DataSource.pm (original)
+++ perl/embperl/trunk/Embperl/Form/DataSource.pm Mon Sep 5 05:34:09 2011
@@ -63,6 +63,36 @@ sub get_values
die "Please overwrite get_values in " . ref $self ;
}
+# ---------------------------------------------------------------------------
+#
+# get_option_from_value - returns the option for a given value
+#
+# in $value value
+# ret option
+#
+
+sub get_option_from_value
+
+ {
+ my ($self, $value, $req, $ctrl) = @_ ;
+
+
+ my ($values, $options) = $self -> get_values ($req, $ctrl) ;
+
+ my $i = 0 ;
+ foreach (@$values)
+ {
+ if ($_ eq $value)
+ {
+ return $options -> [$i] ;
+ }
+ $i++ ;
+ }
+
+ return ;
+ }
+
+
# ---------------------------------------------------------------------------
#
# get_datasource_controls - returns additional controls provided by the
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org