Как проверить одновременный доступ к ресурсу (кешу) в Perl? - PullRequest
Новая
       6

Как проверить одновременный доступ к ресурсу (кешу) в Perl?

2 голосов
/ 29 октября 2010

Как я могу проверить, что ресурс (файловый кеш для вывода кэширования веб-приложения в Perl) ведет себя разумно при одновременном доступе к указанному общему ресурсу?

Я написал простой файловый кеш, написанный на Perl, который использует блокировку для сериализации доступа к записи, то есть, чтобы иметь только один процесс, который (повторно) генерирует запись в кеш. Этот кеш должен использоваться для кэширования вывода Perl webapp (gitweb), если это имеет значение.

Я хотел бы проверить, что указанный кеш ведет себя разумно при одновременном доступе, например, что только один процесс будет выполнять подпрограмму, используемую для генерации кеша ($cache->compute($key, sub { ... })), что все процессы получат сгенерированные данные, что если процесс записывает запись в кеш умирает, она не блокирует процессы, ожидающие (к) повторного создания кеша и т. д.

Как мне это сделать? Есть ли готовый модуль Perl, который я могу использовать?

Ответы [ 3 ]

1 голос
/ 03 ноября 2010

В конце концов я основал свою работу на Unix для программистов на Perl: каналы и процессы от Aaron Crane; хотя в этих заметках он упростил вещи, чтобы не иметь дело с чтением из нескольких процессов без блокировки (в этих заметках временный файл используется для второго потока).

Код использует только Test :: More и не содержит неядерных модулей Perl 

#!/usr/bin/perl

use warnings;
use strict;

use POSIX qw(dup2);
use Fcntl qw(:DEFAULT);
use IO::Handle;
use IO::Select;
use IO::Pipe;

use Test::More;

# [...]

# from http://aaroncrane.co.uk/talks/pipes_and_processes/
sub fork_child (&) {
    my ($child_process_code) = @_;

    my $pid = fork();
    die "Failed to fork: $!\n" if !defined $pid;

    return $pid if $pid != 0;

    # Now we're in the new child process
    $child_process_code->();
    exit;
}

sub parallel_run (&) {
    my $child_code = shift;
    my $nchildren = 2;

    my %children;
    my (%pid_for_child, %fd_for_child);
    my $sel = IO::Select->new();
    foreach my $child_idx (1..$nchildren) {
        my $pipe = IO::Pipe->new()
            or die "Failed to create pipe: $!\n";

        my $pid = fork_child {
            $pipe->writer()
                or die "$$: Child \$pipe->writer(): $!\n";
            dup2(fileno($pipe), fileno(STDOUT))
                or die "$$: Child $child_idx failed to reopen stdout to pipe: $!\n";
            close $pipe
                or die "$$: Child $child_idx failed to close pipe: $!\n";

            # From Test-Simple-0.96/t/subtest/fork.t
            #
            # Force all T::B output into the pipe (redirected to STDOUT),
            # for the parent builder as well as the current subtest builder.
            {
                no warnings 'redefine';
                *Test::Builder::output         = sub { *STDOUT };
                *Test::Builder::failure_output = sub { *STDOUT };
                *Test::Builder::todo_output    = sub { *STDOUT };
            }

            $child_code->();

            *STDOUT->flush();
            close(STDOUT);
        };

        $pid_for_child{$pid} = $child_idx;
        $pipe->reader()
            or die "Failed to \$pipe->reader(): $!\n";
        $fd_for_child{$pipe} = $child_idx;
        $sel->add($pipe);

        $children{$child_idx} = {
            'pid'    => $pid,
            'stdout' => $pipe,
            'output' => '',
        };
    }

    while (my @ready = $sel->can_read()) {
        foreach my $fh (@ready) {
            my $buf = '';
            my $nread = sysread($fh, $buf, 1024);

            exists $fd_for_child{$fh}
                or die "Cannot find child for fd: $fh\n";

            if ($nread > 0) {
                $children{$fd_for_child{$fh}}{'output'} .= $buf;
            } else {
                $sel->remove($fh);
            }
        }
    }

    while (%pid_for_child) {
        my $pid = waitpid -1, 0;
        warn "Child $pid_for_child{$pid} ($pid) failed with status: $?\n"
            if $? != 0;
        delete $pid_for_child{$pid};
    }

    return map { $children{$_}{'output'} } keys %children;
}

# [...]

@output = parallel_run {
    my $data = $cache->compute($key, \&get_value_slow);
    print $data;
};
is_deeply(
    \@output,
    [ ($value) x 2 ],
    'valid data returned by both process'
);
0 голосов
/ 03 ноября 2010

Я бы использовал Test :: Class и Test :: Exception в качестве инфраструктуры для создания тестов.

... например, только один процесс будет запускать подпрограмму, используемую для генерации кеш ($ cache-> compute ($ key, sub {... }))

Вероятно, должно стать что-то вроде этого: 

sub test_inter_process_mutex {
  # spawn process to acquire a lock, capture the pid
  # assert I except when trying to acquire the lock
  # send HUP signal to process, process releases lock and dies
}

чтобы все процессы генерировались данные

Это сложнее. Я, вероятно, попытался бы изолировать коммуникационный механизм и утверждать, что он работает определенным образом.

что если процесс записи в кеш записи умирает это не будет тупик процессов ожидание кеша (пере) генерации и т.д.

становится: 

sub test_no_process_deathgrip {
  # spawn process to acquire the lock and then except
  # assert I can acquire the lock

  # for signals HUP, SIGINT, TERM, and KILL
  # spawn a process to acquire the lock, capture pid
  # send signal to process
  # assert I can acquire the lock
}

}

0 голосов
/ 29 октября 2010

Есть два процесса:

  • Запишите время до доступа.
  • Попытка доступа
  • Спи 5 секунд с замком
  • Снимите блокировку и напишите время.

Один процесс должен занимать вдвое больше времени, чем другой.

Что касается проверки того, очищается ли она, когда процесс умирает. die с замком вместо. Или, если это довольно черный ящик, запустите поток , который вызывает exit, когда вы ожидаете, что процесс заблокирован.

Но я не уверен, как заставить весь процесс спать из одного потока.

...