cvsuser 03/12/03 08:17:00
Modified: App-Context/lib/App Session.pm
Log:
turning Session into a real object (with get()/set() methods) rather than a
glorified hash
Revision Changes Path
1.4 +416 -9 p5ee/App-Context/lib/App/Session.pm
Index: Session.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App/Session.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Session.pm 29 Apr 2003 19:46:31 -0000 1.3
+++ Session.pm 3 Dec 2003 16:16:59 -0000 1.4
@@ -1,13 +1,12 @@
#############################################################################
-## $Id: Session.pm,v 1.3 2003/04/29 19:46:31 spadkins Exp $
+## $Id: Session.pm,v 1.4 2003/12/03 16:16:59 spadkins Exp $
#############################################################################
package App::Session;
use App;
use App::Reference;
[EMAIL PROTECTED] = ( "App::Reference" );
use strict;
@@ -20,11 +19,11 @@
# ... official way to get a Session object ...
use App;
- $session = App->session();
- $session = $session->session(); # get the session
+ $session = App->context();
+ $context = $session->session(); # get the session
# any of the following named parameters may be specified
- $session = $session->session(
+ $session = $context->session(
);
# ... alternative way (used internally) ...
@@ -101,12 +100,79 @@
=head2 new()
-The constructor is inherited from
-L<C<App::Service>|App::Service/"new()">.
+This constructor is used to create Session objects.
+Customized behavior for a particular type of Sessions
+is achieved by overriding the _init() method.
+
+ * Signature: $session = App::Session->new($array_ref)
+ * Signature: $session = App::Session->new($hash_ref)
+ * Signature: $session = App::Session->new("array",@args)
+ * Signature: $session = App::Session->new(%named)
+ * Param: $array_ref []
+ * Param: $hash_ref {}
+ * Return: $session App::Session
+ * Throws: App::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ use "App::Session";
+
+ $ref = App::Session->new("array", "x", 1, -5.4, { pi => 3.1416 });
+ $ref = App::Session->new( [ "x", 1, -5.4 ] );
+ $ref = App::Session->new(
+ arg1 => 'value1',
+ arg2 => 'value2',
+ );
+
+=cut
+
+sub new {
+ &App::sub_entry if ($App::trace_subs);
+ my $this = shift;
+ my $class = ref($this) || $this;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->_init(@_); # allows a subclass to override this portion
+
+ &App::sub_exit($self) if ($App::trace_subs);
+ return $self;
+}
=cut
#############################################################################
+# _init()
+#############################################################################
+
+=head2 _init()
+
+The _init() method is called from within the standard Session constructor.
+The _init() method in this class does nothing.
+It allows subclasses of the Session to customize the behavior of the
+constructor by overriding the _init() method.
+
+ * Signature: _init($named)
+ * Param: $named {} [in]
+ * Return: void
+ * Throws: App::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ $ref->_init($args);
+
+=cut
+
+sub _init {
+ &App::sub_entry if ($App::trace_subs);
+ my $self = shift;
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
@@ -115,6 +181,340 @@
=cut
#############################################################################
+# get()
+#############################################################################
+
+=head2 get()
+
+The get() returns the var of a session_object.
+
+ * Signature: $value = $session->get($service_name_var);
+ * Signature: $value = $session->get($service, $name, $var);
+ * Signature: $value = $session->get($service, $name, $var, $default);
+ * Signature: $value = $session->get($service, $name, $var, $default,
$setdefault);
+ * Param: $service string
+ * Param: $name string
+ * Param: $attribute string
+ * Param: $default any
+ * Param: $setdefault boolean
+ * Return: $value string,ref
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $cname = $session->get("cname");
+ $cname = $session->get("default.cname");
+ $cname = $session->get("SessionObject.default.cname");
+ $cname = $session->get("SessionObject", "default", "cname");
+ $width = $session->get("SessionObject", "main.app.toolbar.calc", "width", 45,
1);
+ $width = $session->get("main.app.toolbar.calc.width", undef, undef, 45,
1);
+
+=cut
+
+sub get {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $service, $name, $var, $default, $setdefault) = @_;
+ if (!defined $name) {
+ if ($service =~ /^([A-Z][^.]*)\.(.+)/) {
+ $service = $1;
+ $name = $2;
+ }
+ else {
+ $name = $service;
+ $service = "SessionObject";
+ }
+ if ($name =~ /^([a-zA-Z0-9_\.-]+)([\{\}\[\]].*)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ elsif ($name =~ /^([a-zA-Z0-9_\.-]+)\.([a-zA-Z0-9_]+)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ else {
+ $var = $name;
+ $name = "default";
+ }
+ }
+
+ my ($perl, $value);
+
+ if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
+ $value = $self->{cache}{$service}{$name}{$var};
+ if (!defined $value && defined $default) {
+ $value = $default;
+ if ($setdefault) {
+ $self->{store}{$service}{$name}{$var} = $value;
+ $self->{context}->service($service, $name) if (!defined
$self->{cache}{$service}{$name});
+ $self->{cache}{$service}{$name}{$var} = $value;
+ }
+ }
+ $self->dbgprint("Session->get($service,$name,$var) (value) = [$value]")
+ if ($App::DEBUG && $self->dbg(3));
+ return $value;
+ } # match {
+ elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
+ $var = $1;
+ $value = $self->{cache}{$service}{$name}{$var};
+ if (!defined $value && defined $default) {
+ $value = $default;
+ if ($setdefault) {
+ $self->{store}{$service}{$name}{$var} = $value;
+ $self->{context}->service($service, $name) if (!defined
$self->{cache}{$service}{$name});
+ $self->{cache}{$service}{$name}{$var} = $value;
+ }
+ }
+ $self->dbgprint("Session->get($service,$name,$var) (value) = [$value]")
+ if ($App::DEBUG && $self->dbg(3));
+ return $value;
+ } # match {
+ elsif ($var =~ /^[\{\}\[\]].*$/) {
+
+ $self->{context}->service($service, $name) if (!defined
$self->{cache}{$service}{$name});
+
+ $var =~ s/\{([^\}]+)\}/\{"$1"\}/g;
+ $perl = "\$value = \$self->{cache}{\$service}{\$name}$var;";
+ eval $perl;
+ $self->add_message("eval [$perl]: $@") if ($@);
+ $self->dbgprint("Session->get($service,$name,$var) (indexed) = [$value]")
+ if ($P5EEx::Blue::DEBUG && $self->dbg(3));
+ }
+
+ &App::sub_exit($value) if ($App::trace_subs);
+ return $value;
+}
+
+#############################################################################
+# set()
+#############################################################################
+
+=head2 set()
+
+The set() sets the value of a variable in one of the Services for the Session.
+
+ * Signature: $session->set($service_name_var, $value);
+ * Signature: $session->set($service, $name, $var, $value);
+ * Param: $service_name_var string
+ * Param: $service string
+ * Param: $name string
+ * Param: $var string
+ * Param: $value string,ref
+ * Return: void
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $session->set("cname", "main_screen");
+ $session->set("default.cname", "main_screen");
+ $session->set("SessionObject.default.cname", "main_screen");
+ $session->set("SessionObject", "default", "cname", "main_screen");
+ $session->set("SessionObject", "main.app.toolbar.calc", "width", 50);
+ $session->set("SessionObject", "xyz", "{arr}[1][2]", 14);
+ $session->set("SessionObject", "xyz", "{arr.totals}", 14);
+
+=cut
+
+sub set {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $service, $name, $var, $value) = @_;
+ if (!defined $value) {
+ $value = $name;
+ $name = undef;
+ }
+ if (!defined $name) {
+ if ($service =~ /^([A-Z][^.]*)\.(.+)/) {
+ $service = $1;
+ $name = $2;
+ }
+ else {
+ $name = $service;
+ $service = "SessionObject";
+ }
+ if ($name =~ /^([a-zA-Z0-9_\.-]+)([\{\}\[\]].*)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ elsif ($name =~ /^([a-zA-Z0-9_\.-]+)\.([a-zA-Z0-9_]+)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ else {
+ $var = $name;
+ $name = "default";
+ }
+ }
+
+ if ($value eq "{:delete:}") {
+ return $self->delete($service,$name,$var);
+ }
+
+ my ($perl);
+ $self->dbgprint("Session->set($name,$var,$value)")
+ if ($App::DEBUG && $self->dbg(3));
+
+ if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
+ $self->{store}{$service}{$name}{$var} = $value;
+ $self->{cache}{$service}{$name}{$var} = $value;
+ return;
+ } # match {
+ elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
+ $var = $1;
+ $self->{store}{$service}{$name}{$var} = $value;
+ $self->{cache}{$service}{$name}{$var} = $value;
+ return;
+ }
+ elsif ($var =~ /^\{/) { # i.e. "{columnSelected}{first_name}"
+
+ $var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
+
+ $perl = "\$self->{store}{$service}{\$name}$var = \$value;";
+ $perl .= "\$self->{cache}{$service}{\$name}$var = \$value;"
+ if (defined $self->{cache}{$service}{$name});
+
+ eval $perl;
+ $self->add_message("eval [$perl]: $@") if ($@);
+ }
+
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+#############################################################################
+# default()
+#############################################################################
+
+=head2 default()
+
+The default() sets the value of a SessionObject's attribute
+only if it is currently undefined.
+
+ * Signature: $session->default($service_name_var, $value);
+ * Signature: $session->default($service, $name, $var, $value);
+ * Param: $service_name_var string
+ * Param: $service string
+ * Param: $name string
+ * Param: $var string
+ * Param: $value string,ref
+ * Return: $value string,ref
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $cname = $session->default("default", "cname");
+ $width = $session->default("main.app.toolbar.calc", "width");
+
+=cut
+
+sub default {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $service, $name, $var, $value) = @_;
+ $self->get($service, $name, $var, $value, 1);
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+#############################################################################
+# delete()
+#############################################################################
+
+=head2 delete()
+
+The delete() deletes an attribute of a session_object in the Session.
+
+ * Signature: $session->delete($service, $name, $attribute);
+ * Param: $service string
+ * Param: $name string
+ * Param: $attribute string
+ * Return: void
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $session->delete("default", "cname");
+ $session->delete("main.app.toolbar.calc", "width");
+ $session->delete("xyz", "{arr}[1][2]");
+ $session->delete("xyz", "{arr.totals}");
+
+=cut
+
+sub delete {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $service, $name, $var) = @_;
+ if (!defined $name) {
+ if ($service =~ /^([A-Z][^.]*)\.(.+)/) {
+ $service = $1;
+ $name = $2;
+ }
+ else {
+ $name = $service;
+ $service = "SessionObject";
+ }
+ if ($name =~ /^([a-zA-Z0-9_\.-]+)([\{\}\[\]].*)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ elsif ($name =~ /^([a-zA-Z0-9_\.-]+)\.([a-zA-Z0-9_]+)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ else {
+ $var = $name;
+ $name = "default";
+ }
+ }
+
+ my ($perl);
+
+ $self->dbgprint("Session->delete($name,$var)")
+ if ($App::DEBUG && $self->dbg(3));
+
+ if (!defined $var || $var eq "") {
+ if ($name =~ /^([a-zA-Z0-9_\.-]+)([\{\}\[\]].*)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ elsif ($name =~ /^([a-zA-Z0-9_\.-]+)\.([a-zA-Z0-9_]+)$/) {
+ $name = $1;
+ $var = $2;
+ }
+ else {
+ $var = $name;
+ $name = "default";
+ }
+ }
+
+ if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
+ delete $self->{store}{$service}{$name}{$var};
+ delete $self->{cache}{$service}{$name}{$var}
+ if (defined $self->{cache}{$service}{$name});
+ return;
+ } # match {
+ elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
+ $var = $1;
+ delete $self->{store}{$service}{$name}{$var};
+ delete $self->{cache}{$service}{$name}{$var}
+ if (defined $self->{cache}{$service}{$name});
+ return;
+ }
+ elsif ($var =~ /^\{/) { # { i.e. "{columnSelected}{first_name}"
+
+ $var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
+
+ $perl = "delete \$self->{store}{$service}{\$name}$var;";
+ $perl .= "delete \$self->{cache}{$service}{\$name}$var;"
+ if (defined $self->{cache}{$service}{$name});
+
+ eval $perl;
+ $self->add_message("eval [$perl]: $@") if ($@);
+ #die "ERROR: Session->delete($name,$var): eval ($perl): $@" if ($@);
+ }
+ # } else we do nothing with it!
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+#############################################################################
# get_session_id()
#############################################################################
@@ -140,6 +540,7 @@
my $seq = 0;
sub get_session_id {
+ &App::sub_entry if ($App::trace_subs);
my $self = shift;
return $self->{session_id} if (defined $self->{session_id});
my ($session_id);
@@ -147,6 +548,7 @@
$session_id = time() . ":" . $$;
$session_id .= ":$seq" if ($seq > 1);
$self->{session_id} = $session_id;
+ &App::sub_exit($session_id) if ($App::trace_subs);
$session_id;
}
@@ -180,10 +582,12 @@
=cut
sub html {
+ &App::sub_entry if ($App::trace_subs);
my ($self, $options) = @_;
my ($session_id, $html);
$session_id = $self->get_session_id();
$html = "<input type=\"hidden\" name=\"app.session_id\" value=\"$session_id\">";
+ &App::sub_exit($html) if ($App::trace_subs);
$html;
}
@@ -209,11 +613,14 @@
use Data::Dumper;
sub dump {
- my ($self) = @_;
- my %copy = %$self;
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $ref) = @_;
+ $ref = $self if (!$ref);
+ my %copy = %$ref;
delete $copy{context}; # don't dump the reference to the context itself
my $d = Data::Dumper->new([ \%copy ], [ "session" ]);
$d->Indent(1);
+ &App::sub_exit($d->Dump()) if ($App::trace_subs);
return $d->Dump();
}
