AnyEvent-Memcached

 view release on metacpan or  search on metacpan

inc/Module/AutoInstall.pm  view on Meta::CPAN

        # make an educated guess of whether we'll need root permission.
        print "    (You may need to do that as the 'root' user.)\n"
          if eval '$>';
    }
    print "*** $class configuration finished.\n";

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';

    return (@Existing, @Missing);
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
    of the dependency's installation later.
END_MESSAGE

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	binmode FH;
	my $string = do { local $/; <FH> };
	close FH or die "close($_[0]): $!";

inc/Module/Install/Makefile.pm  view on Meta::CPAN

}

sub Makefile { $_[0] }

my %seen = ();

sub prompt {
	shift;

	# Infinite loop protection
	my @c = caller();
	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
	}

	# In automated testing or non-interactive session, always use defaults
	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;

lib/AnyEvent/Memcached.pm  view on Meta::CPAN

Alias for "delete"

=head2 remove

Alias for "delete"

=cut

sub delete {
	my $self = shift;
	my ($cmd) = (caller(0))[3] =~ /([^:]+)$/;
	my $key = shift;
	my %args = @_;
	return $args{cb}(undef, "Readonly") if $self->{readonly};
	my $time = $args{delay} ? " $args{delay}" : '';
	return $self->_do(
		$key,
		"delete $self->{namespace}%s$time",
		sub { # cb {
			local $_ = shift;
			if    ($_ eq 'DELETED')    { return 1 }

lib/AnyEvent/Memcached.pm  view on Meta::CPAN

Similar to DBI, zero is returned as "0E0", and evaluates to true in a boolean context.

=head2 decr( $key, $decrement, [cv => $cv], [ noreply => 1 ], cb => $cb->( $rc, $err ) )

Opposite to C<incr>

=cut

sub _delta {
	my $self = shift;
	my ($cmd) = (caller(1))[3] =~ /([^:]+)$/;
	my $key = shift;
	my $val = shift;
	my %args = @_;
	return $args{cb}(undef, "Readonly") if $self->{readonly};
	return $self->_do(
		$key,
		"$cmd $self->{namespace}%s $val",
		sub { # cb {
			local $_ = shift;
			if    ($_ eq 'NOT_FOUND')  { return 0 }

lib/AnyEvent/Memcached.pm  view on Meta::CPAN

=item rv

If passed rv => 'array', then the return value will be arrayref with values in order, returned by memcachedb.

=back

=cut

sub rget {
	my $self = shift;
	#my ($cmd) = (caller(0))[3] =~ /([^:]+)$/;
	my $cmd = 'rget';
	my $from = shift;
	my $till = shift;
	my %args = @_;
	my ($lkey,$rkey);
	#$lkey = ( exists $args{'+left'} && !$args{'+left'} ) ? 1 : 0;
	$lkey = exists $args{'+left'}  ? $args{'+left'}  ? 0 : 1 : 0;
	$rkey = exists $args{'+right'} ? $args{'+right'} ? 0 : 1 : 0;
	$args{max} ||= 100;

t/lib/Test/AE/MC.pm  view on Meta::CPAN

use Test::More;
use AnyEvent::Impl::Perl;
use AnyEvent;
use AnyEvent::Socket;
BEGIN{ eval q{use AnyEvent::Memcached;1} or BAIL_OUT("$@") }
use common::sense;
use utf8;

sub import {
	*{caller().'::runtest'} = \&runtest;
	@_ = 'Test::More';
	goto &{ Test::More->can('import') };
}

sub runtest(&) {
	my $cx = shift;
	my $code = sub {
		alarm 10;
		eval {
			$cx->(@_,noreply => 1, cas => 1);

t/lib/Test/AE/MD.pm  view on Meta::CPAN

use AnyEvent::Impl::Perl;
use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Memcached;
use common::sense;
use utf8;
use Test::More;
use lib::abs;

sub import {
	*{caller().'::runtest'} = \&runtest;
	@_ = 'Test::More';
	goto &{ Test::More->can('import') };
}

sub runtest(&) {
	my $cx = shift;
	my $code = sub {
		alarm 10;
		$cx->(@_,cas => 0, noreply => 0,);
	};