package Maypole::Plugin::Redirect; # array version use strict; use warnings; print "USING Maypole::Plugiin::Redirect"; use Time::HiRes qw(gettimeofday); our $VERSION = '0.01'; use Maypole::Constants; use URI; use URI::QueryParam; # for redirect use Data::Dumper; # for Debugging # redirect to page specified # USE: return $r->redirect('/model_table/action/arg/') unless $blah; # return $r->from_redirect() if '$blah blah blah'; # Saves state, makes new state, and then calls redirect_guts to process the new # request as if it were a normal request -- including checking if its # an applicable request and doing authentication. sub redirect { my ($r, $path) = @_; unless ($path) { return eval { $r->get_redirect->[0]; }; } $r->_save_state; $r->_make_new_state($path); $r->redirect_guts(); # just hanler_guts without the VIEW processing } # from_redirect -- does stuff necessary return to page redirected from. This # restores the saved request and then calls handler guts to process it. # a "Maypole" redirect based on data in session->redirect. sub from_redirect { my $r = shift; $r->_restore_state; $r->redirect_guts; } # returns redirect object or undef; sub get_redirect { my $r = shift; my $sess = $r->_get_redirect_session; $sess->{redirect} = [] unless defined $sess->{redirect}; return $sess->{redirect}; } # return session to put redirect object in sub _get_redirect_session { shift->{session}; } # this is needed every time redirect object is modifed so that it is updated # in session (or so it seemed) sub _stamp_session { my $sess = shift->_get_redirect_session; my ($s, $m) = gettimeofday; $sess->{timestamp} ="$s:$m"; } # Saves distinct elements of request we are redirecting from # so we car return back later if we want. sub _save_state { my $r = shift; my $redir = $r->get_redirect; push @$redir, { model_class => $r->model_class, table => $r->table, action => $r->action, args => $r->args, }; $r->_stamp_session; } sub _make_new_state { my ($r, $path) = @_; my $url = URI->new($path); $r->{path} = $url->path; $r->parse_path; $r->{params} = $url->query_form_hash; warn " path is : " . $r->path . " params are " . $r->params; $r->template(undef); # delete this or model_class process will return # before doing anything } # Restores state of request before redirect. Does nothing if no redirect # Pops last redirect of stack and puts data in $r sub _restore_state { my $r = shift; my $redir = $r->get_redirect; unless (@$redir) { warn "Couldn't restore state No redirects." ; return; } my $top = pop @$redir; #warn "after restore state session is " . Dumper($r->{session}); $r->_stamp_session; $r->model_class( $top->{model_class} ); $r->table($top->{table}); $r->action( $top->{action} ); $r->args( $top->{args} ); $r->template(undef); # delete this or model_class process will return # before doing anything } # redirect_guts(); # This is just Maypole::handler_guts with view class processing (output generation) left out. sub redirect_guts { my $r = shift; $r->model_class( $r->config->model->class_of( $r, $r->{table} ) ); my $applicable = $r->is_applicable; unless ( $applicable == OK ) { # It's just a plain template delete $r->{model_class}; $r->{path} =~ s{/$}{}; # De-absolutify $r->template( $r->{path} ); } # We authenticate every request, needed for proper session management my $status; eval { $status = $r->call_authenticate }; if ( my $error = $@ ) { $status = $r->call_exception($error); if ( $status != OK ) { warn "caught authenticate error: $error"; return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; } } if ( $r->debug and $status != OK and $status != DECLINED ) { $r->view_object->error( $r, "Got unexpected status $status from calling authentication" ); } return $status unless $status == OK; # We run additional_data for every request $r->additional_data; if ( $applicable == OK ) { eval { $r->model_class->process($r) }; if ( my $error = $@ ) { $status = $r->call_exception($error); if ( $status != OK ) { warn "caught model error: $error"; return $r->debug ? $r->view_object->error( $r, $error ) : ERROR; } } } } 1; =head1 LIMITATIONS =cut