view release on metacpan or  search on metacpan

t/04_memcached_multi.t  view on Meta::CPAN

    unlink $socket_file unless -l $socket_file;
    $SIG{__DIE__} = 'IGNORE';
};

start_parent_commanding();

exit 0;

sub start_parent_commanding {
    plan tests => 12;

    my $in;

    print CHILD_SLOW_WTR "save1\n"              or die $!;

    select( undef, undef, undef, QUICK_DELAY );

    print CHILD_QUICK_WTR "read1\n"             or die $!;
    $in = fd_retrieve(\*CHILD_QUICK_RDR)        or die "fd_retrieve";

    ok( $in->{time2} - $in->{time1} < 0.1, 'time of read1' );
    ok( ! defined($in->{value}), 'value of read1' );

    $in = fd_retrieve(\*CHILD_SLOW_RDR);

    ok( abs( DELAY * 2 - $in->{time2} + $in->{time1} ) < 0.1, 'time of save1' );
    ok( defined($in->{value}), 'value of save1 defined' );
    is_deeply( $in->{value}, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'value of save1' );

    print CHILD_SLOW_WTR "save2\n"              or die $!;

    select( undef, undef, undef, QUICK_DELAY );

    print CHILD_QUICK_WTR "read1\n"             or die $!;
    $in = fd_retrieve(\*CHILD_QUICK_RDR)        or die "fd_retrieve";

    ok( $in->{time2} - $in->{time1} < 0.1, 'time of read1(2)' );
    is_deeply( $in->{value}, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ], 'value of save2 before' );

    $in = fd_retrieve(\*CHILD_SLOW_RDR);

    ok( abs( DELAY * 2 - $in->{time2} + $in->{time1} ) < 0.1, 'time of save2' );
    ok( defined($in->{value}), 'value of save2 defined' );
    is_deeply( $in->{value}, [ 101, 102, 103, 104, 105, 106, 107, 108, 109, 110 ], 'value of save2' );

    print CHILD_QUICK_WTR "read1\n"             or die $!;
    $in = fd_retrieve(\*CHILD_QUICK_RDR)        or die "fd_retrieve";

    ok( $in->{time2} - $in->{time1} < 0.1, 'time of read1(3)' );
    is_deeply( $in->{value}, [ 101, 102, 103, 104, 105, 106, 107, 108, 109, 110 ], 'value of save2 after' );

    print CHILD_SLOW_WTR "exit\n"               or die $!;
    print CHILD_QUICK_WTR "exit\n"              or die $!;

    $SIG{__DIE__}->();
}

sub run_slow_process {
    my $line;

    my $cascade = CHI::Cascade->new(
        chi => CHI->new(
            driver              => 'Memcached::Fast',
            servers             => [$socket_file],
            namespace           => 'CHI::Cascade::tests'
        )
    );

    set_cascade_rules($cascade, DELAY);

    my $out;

    while ($line = <PARENT_SLOW_RDR>) {
        chomp $line;

        if ($line eq 'save1') {
            $out = {};

            $out->{time1} = time;
            $out->{value} = $cascade->run('one_page_0');
            $out->{time2} = time;
            store_fd $out, \*PARENT_SLOW_WTR;
        }
        elsif ($line eq 'save2') {
            $out = {};

            $big_array_type = 1;
            $cascade->touch('big_array_trigger');

            $out->{time1} = time;
            $out->{value} = $cascade->run('one_page_0');
            $out->{time2} = time;
            store_fd $out, \*PARENT_SLOW_WTR;
        }
        elsif ($line eq 'exit') {
            exit 0;
        }
    }
}

sub run_quick_process {
    my $line;

    my $cascade = CHI::Cascade->new(
        chi => CHI->new(
            driver              => 'Memcached::Fast',
            servers             => [$socket_file],
            namespace           => 'CHI::Cascade::tests'
        )
    );

    set_cascade_rules($cascade, 0);

    my $out;

    while ($line = <PARENT_QUICK_RDR>) {
        chomp $line;

        if ($line eq 'read1') {
            $out = {};

            $out->{time1} = time;
            $out->{value} = $cascade->run('one_page_0');
            $out->{time2} = time;
            store_fd $out, \*PARENT_QUICK_WTR;
        }
        elsif ($line eq 'exit') {
            exit 0;
        }
    }
}

sub setup_for_slow_process {
    pipe(PARENT_SLOW_RDR, CHILD_SLOW_WTR);
    pipe(CHILD_SLOW_RDR,  PARENT_SLOW_WTR);
    CHILD_SLOW_WTR->autoflush(1);
    PARENT_SLOW_WTR->autoflush(1);
}

sub setup_for_quick_process {
    pipe(PARENT_QUICK_RDR, CHILD_QUICK_WTR);
    pipe(CHILD_QUICK_RDR,  PARENT_QUICK_WTR);
    CHILD_QUICK_WTR->autoflush(1);
    PARENT_QUICK_WTR->autoflush(1);
}

sub setup_slow_parent {
    $SIG{__DIE__} = 'IGNORE';
    close PARENT_SLOW_RDR; close PARENT_SLOW_WTR;
}

sub setup_quick_parent {
    $SIG{__DIE__} = 'IGNORE';
    close PARENT_QUICK_RDR; close PARENT_QUICK_WTR;
}

sub setup_slow_child {
    $SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { exit 1 };
    close CHILD_SLOW_RDR; close CHILD_SLOW_WTR;
}

sub setup_quick_child {
    $SIG{TERM} = $SIG{INT} = $SIG{HUP} = sub { exit 1 };
    close CHILD_QUICK_RDR; close CHILD_QUICK_WTR;
}

sub set_cascade_rules {
    my ($cascade, $delay) = @_;

    $cascade->rule(
        target          => 'big_array_trigger',
        code            => sub {
            return [];
        }
    );

    $cascade->rule(
        target          => 'big_array',
        depends         => 'big_array_trigger',
        code            => sub {
            select( undef, undef, undef, $delay )
              if ($delay);

            return $big_array_type ? [ 101 .. 1000 ] : [ 1 .. 1000 ];
        }
    );

    $cascade->rule(
        target          => qr/^one_page_(\d+)$/,
        depends         => 'big_array',
        code            => sub {
            my ($rule, $target, $values) = @_;

            my ($page) = $target =~ /^one_page_(\d+)$/;

            select( undef, undef, undef, $delay )
              if ($delay);

            my $ret = [ @{$values->{big_array}}[ ($page * 10) .. (( $page + 1 ) * 10 - 1) ] ];
            $ret;
        }
    );
}