Author: spadkins
Date: Tue Nov 9 15:17:46 2010
New Revision: 14519
Modified:
p5ee/trunk/App-Context/lib/App/ValueDomain.pm
Log:
add caching for ValueDomains
Modified: p5ee/trunk/App-Context/lib/App/ValueDomain.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/ValueDomain.pm (original)
+++ p5ee/trunk/App-Context/lib/App/ValueDomain.pm Tue Nov 9 15:17:46 2010
@@ -98,7 +98,7 @@
sub values {
&App::sub_entry if ($App::trace);
my ($self, $values_string) = @_;
- $self->_load($values_string);
+ $self->load($values_string);
&App::sub_exit($self->{values}) if ($App::trace);
return($self->{values});
}
@@ -128,7 +128,7 @@
sub labels {
my ($self, $values_string) = @_;
&App::sub_entry if ($App::trace);
- $self->_load($values_string);
+ $self->load($values_string);
&App::sub_exit($self->{labels}) if ($App::trace);
return($self->{labels});
}
@@ -161,7 +161,7 @@
sub values_labels {
my ($self, $values_string) = @_;
&App::sub_entry if ($App::trace);
- $self->_load($values_string);
+ $self->load($values_string);
&App::sub_exit($self->{values}, $self->{labels}) if ($App::trace);
return($self->{values}, $self->{labels});
}
@@ -187,21 +187,118 @@
sub get_label {
my ($self, $value) = @_;
&App::sub_entry if ($App::trace);
- $self->_load() if (!$self->{labels});
- my $labels = $self->{labels};
- my ($label);
- if (exists $labels->{$value}) {
- $label = $labels->{$value} || $value;
- }
- else {
- $label = $self->_load_label($value);
- $labels->{$value} = $label;
- }
+ $self->load() if (!$self->{labels});
+ my $labels = $self->{labels};
+ my ($label);
+ if (exists $labels->{$value}) {
+ $label = $labels->{$value} || $value;
+ }
+ else {
+ $label = $self->_load_label($value);
+ $labels->{$value} = $label;
+ }
&App::sub_exit($label) if ($App::trace);
return($label);
}
#############################################################################
+# load()
+#############################################################################
+
+=head2 load()
+
+The load() method is called to get the list of valid values in a data
+domain and the labels that should be used to represent these values to
+a user.
+
+ * Signature: $self->load()
+ * Signature: $self->load($values_string)
+ * Param: $values_string string
+ * Return: void
+ * Throws: App::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ $self->load();
+
+=cut
+
+sub load {
+ &App::sub_entry if ($App::trace);
+ my ($self, $values_string) = @_;
+
+ if (defined $values_string && $values_string ne "") {
+ $self->_load($values_string);
+ }
+ elsif ($self->{cached}) {
+ my $cache_refresh_time = $self->{cache_refresh_time} || 24*3600;
+ my $context = $self->{context};
+ my $options = $context->{options};
+ my $prefix = $options->{prefix};
+ my $name = $self->{name};
+ $name =~ s/([^a-zA-Z0-9_\-. ])/uc sprintf("%%%02x",ord($1))/eg;
+ $name =~ tr/ /_/; # spaces become underscores
+ my $cache_file = "$prefix/data/app/ValueDomain/$name";
+ my $save_in_cache_file = 0;
+ my ($value, $label, $values, $labels);
+ if (-f $cache_file) {
+ my $mtime = (stat(_))[9];
+ my $time = time();
+ if ($time - $mtime >= $cache_refresh_time) {
+ $self->_load($values_string);
+ $save_in_cache_file = 1;
+ }
+ elsif (!$self->{values}) {
+ if (open(my $fh, "<", $cache_file)) {
+ $values = [];
+ $labels = {};
+ $self->{values} = $values;
+ $self->{labels} = $labels;
+ while (<$fh>) {
+ if (/^([^\|]*)\|(.*)/) {
+ $value = $1;
+ $label = $2;
+ $label = $value if ($label eq "");
+ push(@$values, $value);
+ $labels->{$value} = $label;
+ }
+ }
+ close($fh);
+ }
+ else {
+ $self->_load($values_string);
+ }
+ }
+ }
+ else {
+ $self->_load($values_string);
+ $save_in_cache_file = 1;
+ }
+ if ($save_in_cache_file) {
+ if (! -f $cache_file) {
+ mkdir("$prefix/data") if (! -d "$prefix/data");
+ mkdir("$prefix/data/app") if (! -d
"$prefix/data/app");
+ mkdir("$prefix/data/app/ValueDomain") if (! -d
"$prefix/data/app/ValueDomain");
+ }
+ if (open(my $fh, ">", $cache_file)) {
+ $values = $self->{values};
+ $labels = $self->{labels};
+ foreach $value (@$values) {
+ $label = $labels->{$value} || $value;
+ print $fh "$value|$label\n";
+ }
+ close($fh);
+ }
+ }
+ }
+ else {
+ $self->_load($values_string);
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
# _load()
#############################################################################
@@ -227,6 +324,7 @@
sub _load {
&App::sub_entry if ($App::trace);
my ($self, $values_string) = @_;
+
$self->{values} = [] if (!$self->{values});
my $values = $self->{values};
$self->{labels} = {} if (!$self->{labels});
@@ -240,7 +338,7 @@
sub _load_label {
my ($self, $value) = @_;
&App::sub_entry if ($App::trace);
- my $label = undef;
+ my $label = undef;
&App::sub_exit($label) if ($App::trace);
return($label);
}
@@ -288,6 +386,7 @@
=head1 ACKNOWLEDGEMENTS
+ * (c) 2010 Stephen Adkins
* Author: Stephen Adkins <[email protected]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
