http-webtest-commits

[Ilya M. <m_...@us...>]

Update of /cvsroot/http-webtest/HTTP-WebTest-Recorder/lib/HTTP/WebTest
In directory sc8-pr-cvs1:/tmp/cvs-serv22742/lib/HTTP/WebTest

Modified Files:
	Controller.pm 
Log Message:
Support redirects


Index: Controller.pm
===================================================================
RCS file: /cvsroot/http-webtest/HTTP-WebTest-Recorder/lib/HTTP/WebTest/Controller.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Controller.pm	18 Jan 2003 18:51:13 -0000	1.3
--- Controller.pm	24 Jan 2003 09:36:49 -0000	1.4
***************
*** 9,12 ****
--- 9,13 ----
  use HTTP::Status;
  use HTTP::WebTest::Utils qw(make_access_method);
+ use HTTP::WebTest::Exceptions;
  use Template;
  
***************
*** 29,36 ****
  *request = make_access_method('REQUEST');
  
! my %DISPATCH = (list     => 'HTTP::WebTest::Action::List',
!                 request  => 'HTTP::WebTest::Action::Request',
!                 wtscript => 'HTTP::WebTest::Action::WTScript',
!                 default  => 'HTTP::WebTest::Action');
  
  # serves requests for web interface of the proxy
--- 30,40 ----
  *request = make_access_method('REQUEST');
  
! use vars qw(%DISPATCH);
! 
! %DISPATCH = (list     => 'HTTP::WebTest::Action::List',
!              request  => 'HTTP::WebTest::Action::Request',
!              wtscript => 'HTTP::WebTest::Action::WTScript',
!              enable   => 'HTTP::WebTest::Action::Enable',
!              default  => 'HTTP::WebTest::Action');
  
  # serves requests for web interface of the proxy
***************
*** 49,53 ****
      my $action = $action_package->new;
  
!     return $self->process_template($action->execute($self));
  }
  
--- 53,70 ----
      my $action = $action_package->new;
  
!     my $response;
!     eval {
!         $response = $self->process_template($action->execute($self));
!     };
!     if($@) {
!         if($@->isa('HTTP::WebTest::Exception::Redirect')) {
!             $response = HTTP::Response->new(RC_FOUND);
!             $response->header(Location => $@->url);
!         } else {
!             $@->rethrow;
!         }
!     };
!     $response->header(Pragma => 'No-Cache');
!     return $response;
  }
  
***************
*** 75,78 ****
--- 92,104 ----
          return $response;
      }
+ }
+ 
+ # generates redirect exception
+ sub redirect {
+     my $self = shift;
+     my $url = shift;
+ 
+     HTTP::WebTest::Exception::Redirect->throw(message => 'Redirect',
+                                               url => $url);
  }