File Coverage

blib/lib/Redis/LeaderBoard.pm
Criterion Covered Total %
statement 14 78 17.9
branch 0 34 0.0
condition 0 3 0.0
subroutine 5 17 29.4
pod 11 11 100.0
total 30 143 20.9


line stmt bran cond sub pod time code
1             package Redis::LeaderBoard;
2 9     9   1177346 use 5.008001;
  9         35  
3             our $VERSION = "1.00";
4 9     9   752 use Mouse;
  9         39064  
  9         101  
5 9     9   3900 use Mouse::Util::TypeConstraints;
  9         35  
  9         79  
6 9     9   6047 use Redis::LeaderBoard::Member;
  9         20  
  9         1266  
7              
8             has key => (
9             is => 'ro',
10             isa => 'Str',
11             required => 1,
12             );
13              
14             has redis => (
15             is => 'ro',
16             isa => 'Object',
17             required => 1,
18             );
19              
20             enum 'Redis::LeaderBoard::Order' => qw/asc desc/;
21             has order => (
22             is => 'ro',
23             isa => 'Redis::LeaderBoard::Order',
24             default => 'desc',
25             );
26              
27             has is_asc => (
28             is => 'ro',
29             isa => 'Bool',
30             lazy => 1,
31             default => sub { shift->order eq 'asc' },
32             );
33              
34             has expire_at => (
35             is => 'ro',
36             isa => 'Int',
37             );
38              
39 9     9   54 no Mouse;
  9         20  
  9         55  
40              
41             sub find_member {
42 0     0 1   my ($self, $member) = @_;
43              
44 0           Redis::LeaderBoard::Member->new(
45             member => $member,
46             leader_board => $self,
47             );
48             }
49              
50             sub set_score {
51 0     0 1   my ($self, @member_and_scores) = @_;
52 0           @member_and_scores = reverse @member_and_scores;
53 0           $self->redis->zadd($self->key, @member_and_scores);
54 0           $self->_set_expire;
55             }
56              
57             sub get_score {
58 0     0 1   my ($self, $member) = @_;
59 0           $self->redis->zscore($self->key, $member);
60             }
61              
62             sub incr_score {
63 0     0 1   my ($self, $member, $score) = @_;
64 0 0         $score = defined $score ? $score : 1;
65              
66 0           my $ret = $self->redis->zincrby($self->key, $score, $member);
67 0           $self->_set_expire;
68 0           $ret;
69             }
70              
71             sub decr_score {
72 0     0 1   my ($self, $member, $score) = @_;
73 0 0         $score = defined $score ? $score : 1;
74              
75 0           my $ret = $self->redis->zincrby($self->key, -$score, $member);
76 0           $self->_set_expire;
77 0           $ret;
78             }
79              
80             sub _set_expire {
81 0     0     my $self = shift;
82 0 0         $self->redis->expireat($self->key, $self->expire_at) if $self->expire_at;
83             }
84              
85             sub remove {
86 0     0 1   my ($self, @members) = @_;
87              
88 0           $self->redis->zrem($self->key, @members);
89             }
90              
91             sub get_sorted_order {
92 0     0 1   my ($self, $member) = @_;
93              
94 0 0         my $method = $self->is_asc ? 'zrank' : 'zrevrank';
95 0           $self->redis->$method($self->key, $member);
96             }
97              
98             sub get_rank_with_score {
99 0     0 1   my ($self, $member) = @_;
100 0           my $redis = $self->redis;
101              
102 0           my $score = $self->get_score($member);
103 0 0         return unless defined $score;
104              
105 0 0         my $method = $self->is_asc ? 'zrank' : 'zrevrank';
106 0           my $rank = $self->get_sorted_order($member);
107              
108 0 0         return (1, $score) if $rank == 0; # zero origin
109              
110 0 0         my ($min, $max) = $self->is_asc ? ('-inf', "($score") : ("($score", 'inf');
111 0           my $above_count = $self->member_count($min, $max);
112 0           $rank = $above_count + 1;
113              
114 0           ($rank, $score);
115             }
116              
117             sub get_rank {
118 0     0 1   my ($self, $member) = @_;
119              
120 0           my ($rank) = $self->get_rank_with_score($member);
121 0           $rank;
122             }
123              
124             sub rankings {
125 0     0 1   my ($self, %args) = @_;
126 0 0         my $limit = exists $args{limit} ? $args{limit} : $self->member_count;
127 0 0         my $offset = exists $args{offset} ? $args{offset} : 0;
128              
129 0 0         my $range_method = $self->is_asc ? 'zrange' : 'zrevrange';
130              
131 0           my $members_with_scores = $self->redis->$range_method($self->key, $offset, $offset + $limit - 1, 'WITHSCORES');
132 0 0         return [] unless @$members_with_scores;
133              
134 0           my @rankings;
135 0           my ($current_rank, $current_target_score, $same_score_members);
136 0           while (my ($member, $score) = splice @$members_with_scores, 0, 2) {
137 0 0         if (!$current_rank) {
    0          
138 0           $current_rank = $self->get_rank($member);
139 0           $same_score_members = $offset - $current_rank + 2;
140 0           $current_target_score = $score;
141             }
142             elsif ($score == $current_target_score) {
143 0           $same_score_members++;
144             }
145             else {
146 0           $current_target_score = $score;
147 0           $current_rank = $current_rank + $same_score_members;
148 0           $same_score_members = 1;
149             }
150 0           push @rankings, +{
151             member => $member,
152             score => $score,
153             rank => $current_rank,
154             };
155             }
156              
157 0           \@rankings;
158             }
159              
160             sub member_count {
161 0     0 1   my ($self, $from, $to) = @_;
162              
163 0 0 0       if (!$from && !$to) {
164 0           $self->redis->zcard($self->key);
165             }
166             else {
167 0 0         $from = defined $from ? $from : '-inf';
168 0 0         $to = defined $to ? $to : 'inf';
169 0           $self->redis->zcount($self->key, $from, $to);
170             }
171             }
172              
173             1;
174             __END__