X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=t%2Flib%2FDebbugsTest.pm;h=603b6ecd35a904f7af49424c831bf6fd09326b5a;hb=a89fb6f83e17fe0afe9436227c50a7a78be8321e;hp=4e510f6af3a8bcd3debcba17f800fc8c6894a661;hpb=a0b230f7f24a056ba0e08f4d3ed820f6986e8202;p=debbugs.git diff --git a/t/lib/DebbugsTest.pm b/t/lib/DebbugsTest.pm index 4e510f6..603b6ec 100644 --- a/t/lib/DebbugsTest.pm +++ b/t/lib/DebbugsTest.pm @@ -82,6 +82,7 @@ sub create_debbugs_configuration { \$gSpoolDir='$spool_dir'; \$gLibPath='@{[getcwd()]}/scripts'; \$gTemplateDir='@{[getcwd()]}/templates'; +\$gWebDir='@{[getcwd()]}/html'; \$gWebHost='localhost'; 1; END @@ -111,9 +112,11 @@ END "$spool_dir/index.archive"); # create the spool files and sub directories - map {system('mkdir','-p',"$spool_dir/$_"); } - map {('db-h/'.$_,'archive/'.$_)} - map { sprintf "%02d",$_ % 100} 0..99; + for my $dir (0..99) { + for my $archive (qw(db-h archive)) { + system('mkdir','-p',"$spool_dir/$archive/".sprintf('%02d',$dir)); + } + } system('mkdir','-p',"$spool_dir/incoming"); system('mkdir','-p',"$spool_dir/lock"); @@ -145,6 +148,9 @@ sub send_message{ }, body => {type => SCALAR, }, + attachments => {type => ARRAYREF, + default => [], + }, run_processall =>{type => BOOLEAN, default => 1, }, @@ -153,13 +159,17 @@ sub send_message{ $ENV{LOCAL_PART} = $param{to}; my ($rfd,$wfd); my $output=''; - local $SIG{PIPE} = 'IGNORE'; - local $SIG{CHLD} = sub {}; + my $pipe_handler = $SIG{PIPE}; + $SIG{PIPE} = 'IGNORE'; + $SIG{CHLD} = 'DEFAULT'; my $pid = open3($wfd,$rfd,$rfd,'scripts/receive') or die "Unable to start receive: $!"; print {$wfd} create_mime_message($param{headers}, - $param{body}) or die "Unable to to print to receive"; + $param{body}, + $param{attachments}) or + die "Unable to to print to receive"; close($wfd) or die "Unable to close receive"; + $SIG{PIPE} = $pipe_handler; my $err = $? >> 8; my $childpid = waitpid($pid,0); if ($childpid != -1) { @@ -185,7 +195,7 @@ sub send_message{ { package DebbugsTest::HTTPServer; - use base qw(HTTP::Server::Simple::CGI); + use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment); our $child_pid = undef; our $webserver = undef;