Когда я бегуDevel::Cover сModPerl::RegistryЯ не получаю информацию о покрытии за исключениемBEGIN блоки. Когда я запускаю тот же скрипт сDevel::Cover из командной строки или в виде CGI все работает хорошо (очевидно).

Как я могу сделатьDevel::Cover «увидеть» мой код выполняется во время выполнения?

ВотDevel::Cover связанные вещи в моемhttpd.conf:

MaxClients 1
PerlSetEnv DEVEL_COVER_OPTIONS -db,/tmp/cover_db,-silent,1
PerlRequire /var/www/project/startup.pl

Вотstartup.pl:

#!/usr/bin/perl
use strict;
use warnings;

use Apache2::Directive ();

BEGIN {
    # Devel::Cover database must be writable by worker processes
    my $conftree = Apache2::Directive::conftree->as_hash;
    my $name = $conftree->{User}
        or die "couldn't find user in Apache config";
    print "user=$name\n";

    my $uid = getpwnam($name);
    defined $uid
        or die "couldn't determine uid by name";

    no warnings 'redefine';
    local 
#!/usr/bin/perl
use strict;
use warnings;

use Apache2::Directive ();

BEGIN {
    # Devel::Cover database must be writable by worker processes
    my $conftree = Apache2::Directive::conftree->as_hash;
    my $name = $conftree->{User}
        or die "couldn't find user in Apache config";
    print "user=$name\n";

    my $uid = getpwnam($name);
    defined $uid
        or die "couldn't determine uid by name";

    no warnings 'redefine';
    local $> = $uid;

    require Devel::Cover;

    my $old_report = \&Devel::Cover::report;
    *Devel::Cover::report = sub { local $> = $uid; $old_report->(@_) };

    Devel::Cover->import;
}

1;
gt; = $uid;

    require Devel::Cover;

    my $old_report = \&Devel::Cover::report;
    *Devel::Cover::report = sub { local 
#!/usr/bin/perl
use strict;
use warnings;

use Apache2::Directive ();

BEGIN {
    # Devel::Cover database must be writable by worker processes
    my $conftree = Apache2::Directive::conftree->as_hash;
    my $name = $conftree->{User}
        or die "couldn't find user in Apache config";
    print "user=$name\n";

    my $uid = getpwnam($name);
    defined $uid
        or die "couldn't determine uid by name";

    no warnings 'redefine';
    local $> = $uid;

    require Devel::Cover;

    my $old_report = \&Devel::Cover::report;
    *Devel::Cover::report = sub { local $> = $uid; $old_report->(@_) };

    Devel::Cover->import;
}

1;
gt; = $uid; $old_report->(@_) };

    Devel::Cover->import;
}

1;

(Как вы можете видеть, я сделал обезьяну патч дляDevel::Cover посколькуstartup.pl управляетсяroot, но рабочие процессы выполняются под другим пользователем, и в противном случае они не могут читать каталоги, созданныеstartup.pl, Если вы знаете лучшее решение, запишите, пожалуйста.)