Как я могу издеваться над веб-сервером в Perl? - PullRequest
4 голосов
/ 15 июля 2009

Наше веб-приложение работает вместе с несколькими веб-сервисами, на которые мы не можем повлиять. После каждого рабочего процесса (тестируемого с Selenium) происходит вызов хука веб-сервиса. Я хотел бы издеваться над этим сервером. В идеале мне нужен объект HTTP-сервера, который я могу запускать и уничтожать по желанию, и диспетчер URL-адресов, который при вызове вызывал бы определенные подпрограммы в моем тесте.

Пока что я нашел HTTP::Server::Simple и HTTP::Server::Brick, и я нашел последнее более привлекательным. Есть ли у вас другие советы инсайдеров?

Ответы [ 5 ]

5 голосов
/ 22 июля 2009

Для этого я использовал комбинацию HTTP :: Daemon и Template :: Toolkit.

package Test::WebService;

use HTTP::Daemon;
use HTTP::Response;
use IO::File;
use Template;

our $PID  = $$;

END { __PACKAGE__->StopWeb(); }

sub StartWeb : method {

    my $self    = shift;
    my $port    = shift;
    my %actions = $_[0] && ref($_[0]) eq 'HASH' ? %{ $_[0] } : @_ %2 ? () : @_;

    # Ignore CHLD
    local $SIG{CHLD} = 'IGNORE';

    # Fork
    my $pid = fork();

    if ( $pid == 0 )
    {
        # Create pid file
        _createPid( "/tmp/httpd.pid" );

        # Create server
        eval
        {
            # Create socket
            my $d = HTTP::Daemon->new
            (
                Listen      => 1, 
                LocalPort   => $port,
                Reuse       => 1,
            ) || die "Failed to bind socket";

            # Listen for connections
            while ( my $c = $d->accept )
            {
                # Process requests
                while ( my $r = $c->get_request() )
                {               
                    if ( defined( my $tmpl = $actions{ $r->uri()->path() } ) )
                    {
                        eval
                        {
                            # Create template object
                            my $tt = Template->new( {ABSOLUTE => 1 } );

                            # Create response
                            my $rs = HTTP::Response->new('200');

                            # Process template
                            $tt->process
                            (
                                $tmpl,
                                $r->uri()->query_form_hash(),
                                sub { $rs->content( shift ) }
                            );

                            # Send response
                            $c->send_response( $rs );
                        };

                        if ($@)
                        {
                            $c->send_error('500', $@ );
                        }

                    }
                    else
                    {
                        $c->send_error('404', 'No Template Found');
                    }
                }
            }
        };

        if ($@)
        {
            # Remove pid file
            unlink "/tmp/httpd.pid";

            # die
            die $@;
        }

        # Exit nicely
        exit(0);
    }

    # Wait up to 5 seconds for server to start;
    die "Failed to start http server" unless _waitpid( 5, "/tmp/httpd.pid" );   

}

sub StopWeb {

    # Only cleanup parent process.
    if ( $PID && $PID == $$ )
    {
        if ( my $fh = IO::File->new( "/tmp/httpd.pid", 'r') )
        {
            # Get pid.
            my $pid;
            $fh->read( $pid, 16384 ); 
            $pid =~ s/\D//g;

            # Kill server
            kill 4, $pid if $pid;
        }
    }
}

sub _createPid {

    my $fh = IO::File->new( shift, 'w') || die "Couldn't create pid";
    $fh->print("$$");
    $fh->close(); 

    return;
}

sub _waitpid {

    my $secs = shift || 5;
    my $file = shift || die "Missing pid file";

    for( my $i=0; $i < $secs; $i++ )
    {
        return 1 if -e $file;
        sleep 1;
    }

    return 0;
}

Тогда код теста можно записать так:

#!/usr/bin/perl

use Test::More tests => 1;
use Test::WebService;

use MyApp;

Test::WebService->StartWeb( '8088', '/webservice/method' => 'my.tmpl' );

ok ( MyApp->methodThatCallsWebService(), 'yay!' );

1;
2 голосов
/ 16 июля 2009

Для хорошего примера посмотрите на набор тестов для WWW :: Mechanize , который использует HTTP :: Server :: Simple :: CGI .

1 голос
/ 15 июля 2009

Я нашел HTTP::Request::AsCGI полезным для тестирования веб-приложения, реализующего интерфейс CGI. Со стороны вызывающего он ведет себя как HTTP::Request.

Возможно, вы захотите попробовать реализовать интерфейс к внешнему API как CGI.pm совместимый модуль.

0 голосов
/ 24 июня 2019

Еще одна возможность, созданная специально для тестирования: Test :: Fake :: HTTPD.

0 голосов
/ 15 июля 2009

Net :: HTTPServer довольно гибкий и относительно зрелый.

Может вызывать подпрограммы на основе URL-пути.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...