Mercurial > hg > nginx-tests
view lib/Test/Nginx.pm @ 14:d4b74207a627
Tests: refactor common functions.
Let it be something more structured, avoid globals.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Fri, 12 Sep 2008 20:50:35 +0400 |
parents | _common.pm@d19146b30334 |
children | c6c36d7a4d90 |
line wrap: on
line source
package Test::Nginx; # (C) Maxim Dounin # Generict module for nginx tests. ############################################################################### use warnings; use strict; use base qw/ Exporter /; our @EXPORT = qw/ log_in log_out http /; ############################################################################### use File::Temp qw/ tempdir /; use IO::Socket; use Socket qw/ CRLF /; ############################################################################### sub new { my $self = {}; bless $self; return $self; } sub DESTROY { my ($self) = @_; $self->stop(); } # Create temp directory and run nginx instance. sub run { my ($self, $conf) = @_; my $testdir = tempdir('nginx-test-XXXXXXXXXX', TMPDIR => 1, CLEANUP => not $ENV{LEAVE}) or die "Can't create temp directory: $!\n"; $self->{_testdir} = $testdir; system("cat $conf | sed 's!%%TESTDIR%%!$testdir!g' " . "> $testdir/nginx.conf"); my $pid = fork(); die "Unable to fork(): $!\n" unless defined $pid; if ($pid == 0) { exec('../nginx/objs/nginx', '-c', "$testdir/nginx.conf", '-g', "pid $testdir/nginx.pid; " . "error_log $testdir/nginx-error.log debug;") or die "Unable to exec(): $!\n"; } # wait for nginx to start sleep 1; return $self; } sub stop { my ($self) = @_; # terminate nginx by SIGTERM kill 15, `cat $self->{_testdir}/nginx.pid`; wait; return $self; } sub write_file { my ($self, $name, $content) = @_; open F, '>' . $self->{_testdir} . '/' . $name or die "Can't create $name: $!"; print F $content; close F; return $self; } ############################################################################### sub log_out { my ($msg) = @_; $msg =~ s/^/# >> /gm; $msg .= "\n" unless $msg =~ /\n\Z/; print $msg; } sub log_in { my ($msg) = @_; $msg =~ s/^/# << /gm; $msg =~ s/([^\x20-\x7e])/sprintf('\\x%02x', ord($1)) . (($1 eq "\n") ? "\n" : '')/gmxe; $msg .= "\n" unless $msg =~ /\n\Z/; print $msg; } ############################################################################### sub http { my ($request) = @_; my $reply; eval { local $SIG{ALRM} = sub { die "alarm\n" }; alarm(2); my $s = IO::Socket::INET->new( Proto => 'tcp', PeerHost => 'localhost:8080' ); log_out($request); $s->print($request); local $/; $reply = $s->getline(); log_in($reply); alarm(0); }; alarm(0); if ($@) { log_in('(timeout)'); return undef; } return $reply; } ############################################################################### 1; ###############################################################################