use Test::More; use strict; use warnings; use Data::Dumper; require HTTP::Server::Simple; BEGIN { unshift @INC, "../lib"; } # ------------- package TestHelper; use Data::Dumper; our($PID, $PORT, $RECEIVED_METHOD); sub setup { $PORT = 7657; $PID = REST::Client::TestServer->new($PORT)->background(); $Bio::Cellucidate::CONFIG = { host => "http://localhost:$PORT" }; } sub teardown { kill 15, $PID; exit; } sub last_request { my $client = REST::Client->new( { host => "http://localhost:$PORT" } ); eval $client->request('GET', "/test")->responseContent; } # ------------- package REST::Client::TestServer; use base qw(HTTP::Server::Simple::CGI); use File::Basename; use Data::Dumper; our ($LAST_METHOD, $LAST_PATH, $LAST_QUERY, @LAST_KEYWORDS); sub handle_request { my ( $self, $cgi ) = @_; my $path = $cgi->path_info; my $fixture_filename = dirname(__FILE__) . "/fixtures$path"; $fixture_filename =~ s/\/$//; $fixture_filename .= '.http'; if ($path eq '/test') { my $info = { method => $LAST_METHOD, path => $LAST_PATH, query => $LAST_QUERY, keywords => join "", @LAST_KEYWORDS }; $Data::Dumper::Purity = 1; $Data::Dumper::Terse = 1; print "HTTP/1.1 200 OK\r\n"; print "\n"; print Dumper $info; } else { $LAST_METHOD = $ENV{'REQUEST_METHOD'}; $LAST_PATH = $path; $LAST_QUERY = $cgi->Vars; if ($LAST_QUERY->{PUTDATA}) { $LAST_QUERY = $LAST_QUERY->{PUTDATA}; } elsif ($LAST_QUERY->{'XForms:Model'}) { $LAST_QUERY = $LAST_QUERY->{'XForms:Model'}; } @LAST_KEYWORDS = $cgi->keywords; } if ($ENV{'REQUEST_METHOD'} eq 'DELETE') { print "HTTP/1.1 200 OK\r\n"; } elsif ($path ne '/test') { if (-e $fixture_filename) { open FH, $fixture_filename; print ; close FH; } else { print "HTTP/1.1 500\r\n"; die "Can't open $fixture_filename"; } } } sub valid_http_method { my $self = shift; my $method = shift or return 0; return $method =~ /^(?:GET|POST|HEAD|PUT|DELETE|OPTIONS)$/; } 1;