view release on metacpan or  search on metacpan

lib/Apache/Session/Browseable/Redis.pm  view on Meta::CPAN

        );
    }
    return \%res;
}

sub searchOnExpr {
    my ( $class, $args, $selectField, $value, @fields ) = @_;
    my %res;
    if ( $class->isIndexed( $args, $selectField ) ) {
        my $redisObj = $class->_getRedis($args);
        my $cursor   = 0;
        do {
            my ( $new_cursor, $sets ) =
              $redisObj->scan( $cursor, MATCH => "${selectField}_$value" );
            foreach my $set (@$sets) {
                next unless $redisObj->type($set) eq 'set';
                my @keys = $redisObj->smembers($set);
                foreach my $k (@keys) {
                    my $v = $redisObj->get($k);
                    next unless $v;
                    my $tmp = unserialize($v);
                    if ($tmp) {
                        $res{$k} = $class->extractFields( $tmp, @fields );
                    }
                }
            }
            $cursor = $new_cursor;
        } while ( $cursor != 0 );
    }
    else {
        $value = quotemeta($value);
        $value =~ s/\\\*/\.\*/g;
        $value = qr/^$value$/;
        $class->get_key_from_all_sessions(
            $args,
            sub {
                my ( $entry, $id ) = @_;
                return undef unless ( $entry->{$selectField} =~ $value );

lib/Apache/Session/Browseable/Redis.pm  view on Meta::CPAN

    my ( $class, $args, $name ) = @_;
    my $expr = $args->{keysRe} || '^[0-9a-f]{32,}$';
    return ( $name =~ /$expr/o );
}

sub get_key_from_all_sessions {
    my ( $class, $args, $data ) = @_;
    my %res;

    my $redisObj = $class->_getRedis($args);
    my $cursor   = 0;
    do {
        my ( $new_cursor, $keys ) = $redisObj->scan($cursor);
        foreach my $k (@$keys) {

            # Keep only our keys
            next unless $class->isLlngKey( $args, $k );

            # Don't scan sets,...
            next unless $redisObj->type($k) eq 'string';
            eval {
                my $v = $redisObj->get($k);
                next unless $v;

lib/Apache/Session/Browseable/Redis.pm  view on Meta::CPAN

                    $res{$k} = $tmp;
                }
            };
            if ($@) {
                print STDERR "Error in session $k: $@\n";

                # Don't delete, it may own to another app
                #delete $res{$k};
            }
        }
        $cursor = $new_cursor;
    } while ( $cursor != 0 );
    return \%res;
}

sub _getRedis {
    my $class = shift;
    my $args  = shift;

    # Manage undef encoding
    $args->{encoding} = undef
      if (  $args->{encoding}