# @(#)$Id: PersistentState.pm 1165 2012-04-03 10:40:39Z pjf $ package CatalystX::Usul::Plugin::Controller::PersistentState; use strict; use warnings; use version; our $VERSION = qv( sprintf '0.6.%d', q$Rev: 1165 $ =~ /\d+/gmx ); use CatalystX::Usul::Constants; sub get_uri_args { my ($self, $c) = @_; my $cache = $self->_uri_attrs_cache ( $c ); my $model = $self->_uri_attrs_model ( $c ); my $session = $self->_uri_attrs_session( $c ); my @args = (); for my $pair (@{ $cache->{args} || [] }) { my ($cfg_key) = keys %{ $pair }; my $v; unless ($v = $cache->{values}->{ $cfg_key } ) { unless (defined ($v = $model->query_value( $cfg_key ))) { unless (defined ($v = $session->{ $cfg_key }) and length $v) { $v = $self->_uri_attrs_inflate( $c, $pair->{ $cfg_key } ); } } $cache->{values}->{ $cfg_key } = $session->{ $cfg_key } = $v; } push @args, $v; } $self->debug and defined $args[0] and $self->log_debug( 'URI attrs '.__uri_attrs_stringify( @args ) ); return @args; } sub get_uri_query_params { my ($self, $c) = @_; my $cache = $self->_uri_attrs_cache ( $c ); my $model = $self->_uri_attrs_model ( $c ); my $session = $self->_uri_attrs_session( $c ); my $params = {}; for my $cfg_key (keys %{ $cache->{params} || {} }) { my $v = $cache->{values}->{ $cfg_key }; if ($v) { $params->{ $cfg_key } = $v; next } unless (defined ($v = $model->query_value( $cfg_key ))) { unless (defined ($v = $session->{ $cfg_key }) and length $v) { $v = $self->_uri_attrs_inflate( $c, $cache->{params}->{ $cfg_key }); } } $params->{ $cfg_key } = $cache->{values}->{ $cfg_key } = $session->{ $cfg_key } = $v; } return $params; } sub init_uri_attrs { my ($self, $c, $model_class) = @_; $self->_uri_attrs_model_class( $c, $model_class ); my $s = $c->stash; my $conf_key = $self->_uri_attrs_config_key; my $conf_keys = $s->{ $conf_key }->{ $s->{form}->{name} } or return; my $cache = $self->_uri_attrs_cache( $c ); while (my ($key, $conf) = each %{ $conf_keys->{vals} }) { if (defined $conf->{order}) { $cache->{args}->[ $conf->{order} ] = { $key => $conf->{key} }; } else { $cache->{params}->{ $key } = $conf->{key} } } return; } sub persist_state { # When the plugin is loaded $self->can( q(persist_state) ) } sub set_uri_args { my ($self, $c, @args) = @_; $self->get_uri_args( $c ); my $cache = $self->_uri_attrs_cache( $c ); my $session = $self->_uri_attrs_session( $c ); my $count = 0; for my $pair (@{ $cache->{args} || [] }) { my ($cfg_key) = keys %{ $pair }; defined $args[ $count ] and $cache->{values}->{ $cfg_key } = $session->{ $cfg_key } = $args[ $count ]; $count++; } return; } sub set_uri_attrs_or_redirect { my ($self, $c, @args) = @_; if (defined $args[ 0 ]) { $self->set_uri_args( $c, @args ); $self->set_uri_query_params( $c, $c->req->query_params ); return; } my $action = $c->action->reverse; @args = $self->get_uri_args( $c ); ($action and $args[ 0 ]) or return; my $params = $self->get_uri_query_params( $c ); my $uri = $c->uri_for_action( $action, @args, $params ); $c->res->redirect( $uri ); $c->detach(); # Never returns return; } sub set_uri_query_params { my ($self, $c, $params) = @_; $self->get_uri_query_params( $c ); my $cache = $self->_uri_attrs_cache( $c ); my $session = $self->_uri_attrs_session( $c ); for my $cfg_key (keys %{ $cache->{params} || {} }) { defined $params->{ $cfg_key } and $cache->{values}->{ $cfg_key } = $session->{ $cfg_key } = $params->{ $cfg_key }; } return; } # Private methods sub _uri_attrs_cache { my ($self, $c) = @_; my $s = $c->stash; return $s->{ $self->_uri_attrs_stash_key }->{ $s->{form}->{name} } ||= {}; } sub _uri_attrs_config_key { return q(keys); } sub _uri_attrs_inflate { my ($self, $c, $v) = @_; my $s = $c->stash; if (defined $v and $v =~ m{ \[% \s+ (.*) \s+ %\] }msx) { $v = undef; for my $part (split m{ \. }mx, $1) { $v = defined $v ? $v->{ $part } : $s->{ $part }; } } return $v; } sub _uri_attrs_model { my ($self, $c) = @_; return $c->model( $self->_uri_attrs_model_class( $c ) ); } sub _uri_attrs_model_class { my ($self, $c, $class) = @_; my $s = $c->stash; $class ||= q(Base); return $s->{ $self->_uri_attrs_stash_key }->{_model_class} ||= $class; } sub _uri_attrs_session { my ($self, $c) = @_; return $c->session->{ $c->action->namespace || q(root) } ||= {}; } sub _uri_attrs_stash_key { return q(uri_attrs_cache); } # Private subroutines sub __uri_attrs_stringify { return join SPC, map { "'".(defined $_ ? $_ : 'undef')."'" } @_; } 1; __END__ =pod =head1 Name CatalystX::Usul::Plugin::Controller::PersistentState - Set/Get state information on/from the session store =head1 Version 0.6.$Revision: 1165 $ =head1 Synopsis use CatalystX::Usul::PersistentState; =head1 Description Uses the session store to provide state information that is persistent across requests =head1 Subroutines/Methods =head2 get_uri_args my @args = $self->get_uri_args( $c ); =head2 get_uri_query_params =head2 init_uri_attrs =head2 persist_state When the plugin is loaded C<$self->can( q(persist_state) )> =head2 set_uri_args $self->set_uri_args( $c, @args ); =head2 set_uri_attrs_or_redirect; =head2 set_uri_query_params =head1 Diagnostics None =head1 Configuration and Environment None =head1 Dependencies =over 3 =item L<CatalystX::Usul::Constants> =back =head1 Incompatibilities There are no known incompatibilities in this module =head1 Bugs and Limitations There are no known bugs in this module. Please report problems to the address below. Patches are welcome =head1 Author Peter Flanigan, C<< <Support at RoxSoft.co.uk> >> =head1 License and Copyright Copyright (c) 2008-2010 Peter Flanigan. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<perlartistic> This program is distributed in the hope that it will be useful, but WITHOUT WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE =cut # Local Variables: # mode: perl # tab-width: 3 # End: