richter at apache
Sep 10, 2011, 5:42 AM
Post #1 of 1
(234 views)
Permalink
|
|
svn commit: r1167506 - in /perl/embperl/trunk/Embperl/Form: Control/tabs.pm ControlMultValue.pm
|
|
Author: richter
Date: Sat Sep 10 12:42:48 2011
New Revision: 1167506
URL: http://svn.apache.org/viewvc?rev=1167506&view=rev
Log:
Perfomance optimatasitations for MultValueControl
Modified:
perl/embperl/trunk/Embperl/Form/Control/tabs.pm
perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
Modified: perl/embperl/trunk/Embperl/Form/Control/tabs.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/tabs.pm?rev=1167506&r1=1167505&r2=1167506&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/tabs.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/tabs.pm Sat Sep 10 12:42:48 2011
@@ -66,9 +66,13 @@ sub get_active_id
{
my ($self, $req) = @_ ;
+ my $key = "active_id:$self" ;
+ my $id ;
+ return $id if ($id = $req -> {$key}) ;
+
my ($values, $options) = $self -> get_values ($req) ;
my $name = $self -> {name} ;
- my $dataval = $fdat{$name} || $values -> [0] ;
+ my $dataval = $fdat{$name} || $req -> {query}{$name} || $values -> [0] ;
my $activeid ;
my $i = 0 ;
@@ -81,8 +85,7 @@ sub get_active_id
}
$i++ ;
}
-
- return $activeid || $self -> {subids}[0];
+ return $req -> {$key} = $activeid || $self -> {subids}[0];
}
@@ -95,13 +98,13 @@ __EMBPERL__
# show - output the control
#]
-[.$ sub show ($self)
+[.$ sub show ($self, $req)
my ($values, $options) = $self -> get_values ;
my $span = ($self->{width_percent}) ;
my $name = $self -> {name} ;
my $dataval = $fdat{$name} || $values -> [0] ;
- my $activeid = $self -> get_active_id ;
+ my $activeid = $self -> get_active_id ($req) ;
my $nsprefix = $self -> form -> {jsnamespace} ;
my $tabs_per_line = $self -> {'tabs_per_line'} || 99;
$tabs_per_line = [$tabs_per_line, $tabs_per_line, $tabs_per_line, $tabs_per_line]
Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=1167506&r1=1167505&r2=1167506&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Sat Sep 10 12:42:48 2011
@@ -57,6 +57,10 @@ sub get_all_values
{
my ($self, $req) = @_ ;
+ my $key = "all_values:$self" ;
+ my $v ;
+ return @$v if ($v = $req -> {$key}) ;
+
my $addtop = $self -> {addtop} ;
my $addbottom = $self -> {addbottom} ;
@@ -65,8 +69,17 @@ sub get_all_values
if ($self -> {datasrcobj})
{
- ($values, $options) = $self -> {datasrcobj} -> get_values ($req, $self) ;
- $options ||= $values ;
+ my $key = "all_values_datasrc:$self->{datasrcobj}" ;
+ if (my $v = $req -> {$key})
+ {
+ ($values, $options) = @$v ;
+ }
+ else
+ {
+ ($values, $options) = $self -> {datasrcobj} -> get_values ($req, $self) ;
+ $options ||= $values ;
+ $req -> {$key} = [$values, $options] ;
+ }
}
else
{
@@ -76,8 +89,11 @@ sub get_all_values
if (!$self -> {showoptions}) ;
}
- return ($values, $options) if (!$addtop && !$addbottom) ;
-
+ if (!$addtop && !$addbottom)
+ {
+ $req -> {$key} = [$values, $options] ;
+ return ($values, $options)
+ }
my @values ;
my @options ;
if ($addtop)
@@ -98,6 +114,7 @@ sub get_all_values
push @options, map { $_ -> [0] } @$addbottom ;
}
+ $req -> {$key} = [\@values, \@options] ;
return (\@values, \@options) ;
}
@@ -214,6 +231,10 @@ sub get_active_id
{
my ($self, $req) = @_ ;
+ my $key = "active_id:$self" ;
+ my $id ;
+ return $id if ($id = $req -> {$key}) ;
+
my ($values, $options) = $self -> get_values ($req) ;
my $name = $self -> {name} ;
my $dataval = $fdat{$name} || $values -> [0] ;
@@ -230,7 +251,7 @@ sub get_active_id
$i++ ;
}
- return $activeid ;
+ return $req -> {$key} = $activeid ;
}
# ---------------------------------------------------------------------------
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe [at] perl
For additional commands, e-mail: embperl-cvs-help [at] perl
|
