view release on metacpan or  search on metacpan

lib/Redis/CappedCollection.pm  view on Meta::CPAN

            my $error = $_;
            $err_msg = "(Not reconnected: $error)";
        };
    }

    if ( $err_msg ) {
        $msg = defined( $msg )
            ? ( $msg ? "$msg " : '' )."($err_msg)"
            : $err_msg;
    }

    return $msg;
}

sub _throw {
    my ( $self, $err, $prefix ) = @_;

    if ( exists $ERROR{ $err } ) {
        $self->_set_last_errorcode( $err );
        _croak( format_message( '%s%s', ( $prefix ? "$prefix : " : '' ), $ERROR{ $err } ) );
    } else {
        $self->_set_last_errorcode( $E_UNKNOWN_ERROR );
        _croak( format_message( '%s: %s%s', $ERROR{ $E_UNKNOWN_ERROR }, ( $prefix ? "$prefix : " : '' ), format_message( '%s', $err ) ) );
    }

    return;
}

my $_running_script_name;
{
    my $_running_script_body;
    my %script_prepared;

    sub _lua_script_cmd {
        my ( $self, $redis );
        if ( _INSTANCE( $_[0], __PACKAGE__ ) ) {    # allow calling $obj->bar
            $self   = shift;
            $redis  = $self->_redis;
        } else {                                    # allow calling Foo::bar
            $redis  = shift;
        }

        $_running_script_name = shift;
        my $sha1 = $_lua_scripts->{ $redis }->{ $_running_script_name };
        unless ( $sha1 ) {
            unless ( $script_prepared{ $_running_script_name } ) {
                my ( $start_str, $finish_str );
                if ( $DEBUG ) {
                    $start_str  = "
${_lua_log_work_function}
_log_work( 'start', '$_running_script_name', ARGV )
";
                    $finish_str = "
_log_work( 'finish' )
";
                } else {
                    $finish_str = $start_str = '';
                }

                {
                    local $/ = '';
                    $lua_script_body{ $_running_script_name } =~ s/\n+\s*__START_STEP__\n/$start_str/g;
                    $lua_script_body{ $_running_script_name } =~ s/\n+\s*__FINISH_STEP__/$finish_str/g;
                }
                $script_prepared{ $_running_script_name } = 1;
            }

            $_running_script_body = $lua_script_body{ $_running_script_name };
            $sha1 = $_lua_scripts->{ $redis }->{ $_running_script_name } = sha1_hex( $_running_script_body );
            my $ret;
            if ( $self ) {
                $ret = ( $self->_call_redis( 'SCRIPT', 'EXISTS', $sha1 ) )[0];
            } else {
                $ret = ( _call_redis( $redis, 'SCRIPT', 'EXISTS', $sha1 ) )[0];
            }
            return( 'EVAL', $_running_script_body )
                unless $ret;
        }
        return( 'EVALSHA', $sha1 );
    }

    sub _redis_exception {
        my $self;
        $self = shift if _INSTANCE( $_[0], __PACKAGE__ );   # allow calling $obj->bar
        my ( $error ) = @_;                                 # allow calling Foo::bar

        my $err_msg = '';
        if ( $self ) {
            # Use the error messages from Redis.pm
            if (
                       $error =~ /Could not connect to Redis server at /
                    || $error =~ /^Can't close socket: /
                    || $error =~ /^Not connected to any server/
                    # Maybe for pub/sub only
                    || $error =~ /^Error while reading from Redis server: /
                    || $error =~ /^Redis server closed connection/
                ) {
                $self->_set_last_errorcode( $E_NETWORK );

                # For connection problem
                $err_msg = _reconnect( $self->_redis, $E_UNKNOWN_ERROR, $err_msg ) if $self->reconnect_on_error;
            } elsif (
                    $error =~ /^\[[^]]+\]\s+NOSCRIPT No matching script. Please use EVAL./
                ) {
                _clear_sha1( $self->_redis );

                # No connection problem
                return 1;
            } elsif (
                       $error =~ /^\[[^]]+\]\s+-?\Q$REDIS_MEMORY_ERROR_MSG\E/i
                    || $error =~ /^\[[^]]+\]\s+-?\Q$REDIS_ERROR_CODE $ERROR{ $E_MAXMEMORY_LIMIT }\E/i
                ) {
                $self->_set_last_errorcode( $E_MAXMEMORY_LIMIT );

                # No connection problem
            } elsif ( $error =~ /^\[[^]]+\]\s+BUSY Redis is busy running a script/ ){
                $self->_set_last_errorcode( $E_UNKNOWN_ERROR );

                # No connection problem - must wait...
            } else {    # external ALRM processing here
                $self->_set_last_errorcode( $E_REDIS );