File Coverage

File:lib/OpenAPI/Cache.pm
Coverage:61.3%

linestmtbrancondsubpodtimecode
1package OpenAPI::Cache;
2
3
22
22
22
22
168
75
199
use strict;
4
22
22
22
22
241
68
175
use warnings;
5
22
22
22
22
241
68
310
use FindBin;
6
7# This is a hack...
8
9sub new {
10
22
50
22
0
233
    my $class = ref $_[0] ? ref shift : shift;
11
22
107
    my $params = shift;
12
22
133
    my $expire_time = $params->{expired};
13
22
50
214
    my $type = $OpenAPI::Config{'cache.type'} or
14        die "No cache.type specified in the config files.\n";
15
22
79
    my $obj;
16
22
368
    my $self = bless {}, $class;
17
22
128
    my $share_file = "/tmp/openapi-mmap.dat";
18
22
50
25
805
    if (-e $share_file && (!-r $share_file || !-w $share_file)) {
19
22
158
        $share_file = "$FindBin::Bin/openapi-mmap.dat";
20    }
21
22
50
0
173
    if ($type eq 'mmap') {
22
22
362
        require Cache::FastMmap;
23
22
367
        $obj = Cache::FastMmap->new(
24            share_file => $share_file,
25            expire_time => $expire_time,
26        );
27    } elsif ($type eq 'memcached') {
28
0
0
0
        my $list = $OpenAPI::Config{'cache.servers'} or
29            die "No cache.servers specified in the config files.\n";
30
0
0
        require Cache::Memcached::Fast;
31
0
0
        my @addr = split /\s*,\s*|\s+/, $list;
32
0
0
0
        if (!@addr) {
33
0
0
            die "No memcached server found: $list.\n";
34        }
35
0
0
        $obj = Cache::Memcached::Fast->new({
36            servers => [@addr],
37        });
38        #$obj->set(dog => 32);
39        #die "Dog value: ", $obj->get('dog');
40
0
0
        $self->{expire_time} = $expire_time;
41        #die $obj;
42    } else {
43
0
0
        die "Invalid cache.type value: $type\n";
44    }
45
22
254
    $self->{obj} = $obj;
46
22
171
    return $self;
47}
48
49sub set {
50
73
73
0
594
    my ($self, $key, $val) = @_;
51
73
412
    my $expire_time = $self->{expire_time};
52
73
50
1023
    $self->{obj}->set($key, $val, $expire_time ? $expire_time : ());
53}
54
55sub get {
56
515
515
0
7003
    $_[0]->{obj}->get($_[1]);
57}
58
59sub remove {
60
50
50
0
267
    my $self = shift;
61
50
292
    my $obj = $self->{obj};
62
50
50
666
    if ($obj->can('remove')) {
63
50
420
        $obj->remove(@_);
64    } else {
65
0
        $obj->delete(@_);
66    }
67}
68
691;
70