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