cvsuser 02/03/12 09:03:52
Modified: P5EEx/Blue/P5EEx/Blue Context.pm
Log:
add widget_exists(), wdelete(), user_agent() methods
Revision Changes Path
1.21 +269 -83 p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm
Index: Context.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- Context.pm 6 Mar 2002 23:03:24 -0000 1.20
+++ Context.pm 12 Mar 2002 17:03:52 -0000 1.21
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.20 2002/03/06 23:03:24 spadkins Exp $
+## $Id: Context.pm,v 1.21 2002/03/12 17:03:52 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context;
@@ -8,6 +8,7 @@
use strict;
use P5EEx::Blue::P5EE;
+use P5EEx::Blue::UserAgent;
=head1 NAME
@@ -210,6 +211,8 @@
$self->{session} = P5EEx::Blue::P5EE->new($session_class, "new", \%args);
$self->{initconfig} = \%args;
+ $self->{user_agent} = P5EEx::Blue::UserAgent->new($self);
+
return $self;
}
@@ -580,6 +583,51 @@
sub logchannel { my $self = shift; return $self->service("LogChannel",@_); }
#############################################################################
+# widget_exists()
+#############################################################################
+
+=head2 widget_exists()
+
+ * Signature: $exists = $context->widget_exists($widget_name);
+ * Param: $widget_name string
+ * Return: $exists boolean
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ if ($context->widget_exists($widget_name)) {
+ # do something
+ }
+
+The widget_exists() returns whether or not a widget is already known to the
+Context. This is true if
+
+ * it exists in the Session's widget cache, or
+ (i.e. it has already been referenced and instantiated in the cache),
+ * it exists in the Session's state, or
+ (i.e. it was referenced in an earlier request in this session)
+ * it exists in the Config
+
+If this method returns FALSE (undef), then any call to the widget() method
+must specify the widgetClass (at a minimum) and may not simply call it
+with the $widget_name.
+
+This is useful particularly for lightweight widgets which generate events
+(such as image buttons). The $context->dispatch_events() method can check
+that the widget has not yet been defined and automatically passes the
+event to the widget's container (implied by the name) for handling.
+
+=cut
+
+sub widget_exists {
+ my ($self, $widget_name) = @_;
+ return (defined $self->{session}{cache}{Widget}{$widget_name}{widgetClass} ||
+ defined $self->{session}{state}{Widget}{$widget_name}{widgetClass} ||
+ defined $self->{config}{Widget}{$widget_name}{widgetClass});
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
@@ -713,15 +761,19 @@
$context->wset("session", "wname", "main_screen");
$context->wset("main.app.toolbar.calc", "width", 50);
+ $context->wset("xyz", "{arr}[1][2]", 14);
+ $context->wset("xyz", "{arr.totals}", 14);
=cut
-# $self->wset("xyz", "{arr}[1][2]", 14);
-# $self->wset("xyz", "{arr.totals}[1][2]", 14);
sub wset {
my ($self, $name, $var, $value) = @_;
my ($perl);
+ if ($value eq "{:delete:}") {
+ return $self->wdelete($name,$var);
+ }
+
$self->dbgprint("Context->wset($name,$var,$value)")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
@@ -737,25 +789,86 @@
$self->{session}{cache}{Widget}{$name}{$var} = $value
if (defined $self->{session}{cache}{Widget}{$name});
return;
- } # match {
- elsif ($var =~ /^\{/) { # i.e. "{columnSelected}{first_name}"
+ }
+ elsif ($var =~ /^\{/) { # { i.e. "{columnSelected}{first_name}"
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
- $self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
+ #$self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
$perl = "\$self->{session}{state}{Widget}{\$name}$var = \$value;";
- $perl .= "\$self->{session}{cache}{Widget}{\$name}$var = \$value;";
+ $perl .= "\$self->{session}{cache}{Widget}{\$name}$var = \$value;"
+ if (defined $self->{session}{cache}{Widget}{$name});
eval $perl;
- print STDERR "ERROR: Context->wset($name,$var,$value): eval ($perl): $@\n"
if ($@);
+ die "ERROR: Context->wset($name,$var,$value): eval ($perl): $@" if ($@);
}
- # else we do nothing with it!
+ # } else we do nothing with it!
return $value;
}
#############################################################################
+# wdelete()
+#############################################################################
+
+=head2 wdelete()
+
+The wdelete() deletes an attribute of a widget in the Session.
+
+ * Signature: $context->wdelete($widgetname, $attribute);
+ * Param: $widgetname string
+ * Param: $attribute string
+ * Return: void
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $context->wdelete("session", "wname");
+ $context->wdelete("main.app.toolbar.calc", "width");
+ $context->wdelete("xyz", "{arr}[1][2]");
+ $context->wdelete("xyz", "{arr.totals}");
+
+=cut
+
+sub wdelete {
+ my ($self, $name, $var) = @_;
+ my ($perl);
+
+ $self->dbgprint("Context->wdelete($name,$var)")
+ if ($P5EEx::Blue::DEBUG && $self->dbg(3));
+
+ if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
+ delete $self->{session}{state}{Widget}{$name}{$var};
+ delete $self->{session}{cache}{Widget}{$name}{$var}
+ if (defined $self->{session}{cache}{Widget}{$name});
+ return;
+ } # match {
+ elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
+ $var = $1;
+ delete $self->{session}{state}{Widget}{$name}{$var};
+ delete $self->{session}{cache}{Widget}{$name}{$var}
+ if (defined $self->{session}{cache}{Widget}{$name});
+ return;
+ }
+ elsif ($var =~ /^\{/) { # { i.e. "{columnSelected}{first_name}"
+
+ $var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
+
+ #$self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
+
+ $perl = "delete \$self->{session}{state}{Widget}{\$name}$var;";
+ $perl .= "delete \$self->{session}{cache}{Widget}{\$name}$var;"
+ if (defined $self->{session}{cache}{Widget}{$name});
+
+ eval $perl;
+ die "ERROR: Context->wdelete($name,$var): eval ($perl): $@" if ($@);
+ }
+ # } else we do nothing with it!
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
@@ -956,6 +1069,132 @@
}
#############################################################################
+# user_agent()
+#############################################################################
+
+=head2 user_agent()
+
+The user_agent() method returns a UserAgent objects which is primarily
+useful to see what capabilities the user agent (browser) supports.
+
+ * Signature: $user_agent = $context->user_agent();
+ * Param: void
+ * Return: $user_agent P5EEx::Blue::UserAgent
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $user_agent = $context->user_agent();
+
+=cut
+
+sub user_agent {
+ my $self = shift;
+ $self->{user_agent};
+}
+
+#############################################################################
+# domain()
+#############################################################################
+
+=head2 domain()
+
+The domain() 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: ($values, $labels) = $self->domain($domain_name)
+ * Param: $domain_name string
+ * Return: $values []
+ * Return: $labels {}
+ * Throws: P5EEx::Blue::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ ($values, $labels) = $self->domain("gender");
+ foreach (@$values) {
+ print "$_ => $labels->{$_}\n";
+ }
+
+=cut
+
+sub domain {
+ my ($self, $domain) = @_;
+ my ($config, $domainref, $repository, $rep);
+ my ($values, $labels, $needs_loading, $time_to_live, $time);
+ my ($class, $method, $args, $rows, $row);
+
+ $self->dbgprint("Context->domain($domain)")
+ if ($P5EEx::Blue::DEBUG && $self->dbg(1));
+
+ $config = $self->{config}{Domain}{$domain};
+ $domainref = $self->{session}{Domain}{$domain};
+ if (defined $domainref) {
+ $values = $domainref->{values};
+ $values = $config->{values} if (!$values);
+ $labels = $domainref->{labels};
+ $labels = $config->{labels} if (!$labels);
+
+ $needs_loading = 0;
+ $repository = $config->{repository};
+ if (defined $repository && $repository ne "") {
+ if (!defined $values || !defined $labels) {
+ $needs_loading = 1;
+ }
+ else {
+ $time_to_live = $config->{time_to_live};
+ if (defined $time_to_live && $time_to_live ne "" && $time_to_live
>= 0) {
+ if ($time_to_live == 0) {
+ $needs_loading = 1;
+ }
+ else {
+ if (time() >= $domainref->{time} + $time_to_live) {
+ $needs_loading = 1;
+ }
+ }
+ }
+ }
+ }
+
+ $self->dbgprint("Context->domain($domain): needs_loading=$needs_loading")
+ if ($P5EEx::Blue::DEBUG && $self->dbg(1));
+
+ if ($needs_loading) {
+ $rep = $self->repository($repository);
+ if (defined $rep) {
+ #$method = $domainref->{getmethod};
+ #$method = "get" if (!defined $method);
+ #$args = $domainref->{getmethod_args};
+ #$args = [ $domain ] if (!defined $args);
+
+ #$self->dbgprint("Context->domain($domain): $rep->$method(@$args)")
+ # if ($P5EEx::Blue::DEBUG && $self->dbg(1));
+
+ #$rows = ${rep}->${method}(@$args);
+ #$values = [];
+ #$labels = {};
+ #foreach $row (@$rows) {
+ # push(@$values, $row->[0]);
+ # $labels->{$row->[0]} = $row->[1];
+ #}
+ #$domainref->{values} = $values;
+ #$domainref->{labels} = $labels;
+ #$time = time();
+ #$domainref->{time} = $time;
+ }
+
+ $values = $domainref->{values};
+ $labels = $domainref->{labels};
+ }
+ }
+ $values = [] if (! defined $values);
+ $labels = {} if (! defined $labels);
+ return ($values, $labels);
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
@@ -1182,6 +1421,27 @@
);
}
+#############################################################################
+# shutdown()
+#############################################################################
+
+=head2 shutdown()
+
+The shutdown() method is called when the Context is preparing to exit.
+This allows for connections to databases, etc. to be closed gracefully.
+
+ * Signature: $self->shutdown()
+ * Param: void
+ * Return: void
+ * Throws: P5EEx::Blue::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ $self->shutdown();
+
+=cut
+
sub shutdown {
my $self = shift;
my ($config, $repdef, $repname, $instance);
@@ -1202,80 +1462,6 @@
delete $repcache->{$repname};
}
}
-}
-
-sub domain {
- my ($self, $domain) = @_;
- my ($config, $domainref, $repository, $rep);
- my ($values, $labels, $needs_loading, $time_to_live, $time);
- my ($class, $method, $args, $rows, $row);
-
- $self->dbgprint("Context->domain($domain)")
- if ($P5EEx::Blue::DEBUG && $self->dbg(1));
-
- $config = $self->{config}{Domain}{$domain};
- $domainref = $self->{session}{Domain}{$domain};
- if (defined $domainref) {
- $values = $domainref->{values};
- $values = $config->{values} if (!$values);
- $labels = $domainref->{labels};
- $labels = $config->{labels} if (!$labels);
-
- $needs_loading = 0;
- $repository = $config->{repository};
- if (defined $repository && $repository ne "") {
- if (!defined $values || !defined $labels) {
- $needs_loading = 1;
- }
- else {
- $time_to_live = $config->{time_to_live};
- if (defined $time_to_live && $time_to_live ne "" && $time_to_live
>= 0) {
- if ($time_to_live == 0) {
- $needs_loading = 1;
- }
- else {
- if (time() >= $domainref->{time} + $time_to_live) {
- $needs_loading = 1;
- }
- }
- }
- }
- }
-
- $self->dbgprint("Context->domain($domain): needs_loading=$needs_loading")
- if ($P5EEx::Blue::DEBUG && $self->dbg(1));
-
- if ($needs_loading) {
- $rep = $self->repository($repository);
- if (defined $rep) {
- #$method = $domainref->{getmethod};
- #$method = "get" if (!defined $method);
- #$args = $domainref->{getmethod_args};
- #$args = [ $domain ] if (!defined $args);
-
- #$self->dbgprint("Context->domain($domain): $rep->$method(@$args)")
- # if ($P5EEx::Blue::DEBUG && $self->dbg(1));
-
- #$rows = ${rep}->${method}(@$args);
- #$values = [];
- #$labels = {};
- #foreach $row (@$rows) {
- # push(@$values, $row->[0]);
- # $labels->{$row->[0]} = $row->[1];
- #}
- #$domainref->{values} = $values;
- #$domainref->{labels} = $labels;
- #$time = time();
- #$domainref->{time} = $time;
- }
-
- $values = $domainref->{values};
- $labels = $domainref->{labels};
- }
- }
- $values = [] if (! defined $values);
- $labels = {} if (! defined $labels);
- return ($values, $labels);
}
1;
