mala (owner)

Revisions

  • 3afe46 mala Fri May 15 03:40:59 -0700 2009
  • 02940e mala Thu May 14 06:35:39 -0700 2009
  • 877b7b mala Wed May 13 04:44:09 -0700 2009
gist: 110981 Download_button fork
public
Public Clone URL: git://gist.github.com/110981.git
Embed All Files: show embed
Text #
raw 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

package Cache::Migrate;
 
use strict;
use warnings;
use Carp;
 
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(debug));
 
our $VERSION = "0.01";
 
sub new {
    my $class = shift;
    my @opt = @_;
    my $self;
    if (exists $opt[0]->{caches}) {
        $self = {
            debug => $opt[0]->{debug} || 0,
            _cache => $opt[0]->{caches}
        };
    } else {
        $self = {
            _cache => \@opt
        };
    }
    bless $self, $class;
}
 
# delegate setting
# read  request: get,gets
# write request: set,add,replace,cas,incr,decr,append,prepend,delete
 
BEGIN {
    my @read = qw(get gets);
    my @read_multi = map { $_ ."_multi" } @read; 
    my @write = qw(set add replace cas incr decr append prepend delete);
    my @write_multi = map { $_ ."_multi" } @write; 
    
    for my $method_name (@read, @read_multi) {
        eval sprintf(<<'__SUB__', $method_name, $method_name);
        sub %s {
            my $self = shift;
            $self->_delegate_read("%s", @_);
        }
__SUB__
        warn $@ if $@;
    }
 
    for my $method_name (@write, @write_multi) {
        eval sprintf(<<'__SUB__', $method_name, $method_name);
        sub %s {
            my $self = shift;
            $self->_delegate_write("%s", @_);
        }
__SUB__
        warn $@ if $@;
    }
}
 
# select usable cache engine
sub _select_usable_cache {
    my $self = shift;
    return map { $_->{cache} } grep {
        !exists $_->{expires_on} || time < $_->{expires_on} 
    } @{$self->{_cache}};
}
 
# read from first usable cache object
sub _delegate_read {
    my $self = shift;
    my ($method, @args) = @_;
    my ($cache) = $self->_select_usable_cache;
    if (!$cache) {
        carp "can't find usable cache!" if $self->debug;
        return;
    }
    $cache->$method(@args);
}
 
# write for all usable cache object
sub _delegate_write {
    my $self = shift;
    my ($method, @args) = @_;
    my @all = $self->_select_usable_cache;
    my @result;
    my $result;
    if (!@all) {
        carp "can't find usable cache!" if $self->debug;
        return;
    }
    warn sprintf("%d usable cache object(s)", scalar @all) if $self->debug;
    for my $cache (@all) {
        if (wantarray) {
            @result = $cache->$method(@args);
        } else {
            $result = $cache->$method(@args);
        }
    }
    return wantarray ? @result : $result;
}
 
1;
 
__END__
 
=pod
 
=head1 NAME
 
Cache::Migrate 
 
=head1 SYNOPSIS
 
 use Cache::Migrate;
 use Date::Parse;
 use Cache::Memcached::Fast;
 
 $old_cache = Cache::Memcached::Fast->new({servers => ["127.0.0.1:11211"] });
 $new_cache = Cache::Memcached::Fast->new({servers => ["127.0.0.1:11212"] });
 $cache = Cache::Migrate->new(
     { cache => $old_cache, expires_on => str2time("2009/05/15 00:00:00") },
     { cache => $new_cache },
 );
  or 
 $cache = Cache::Migrate->new({
     debug => 1,
     caches => [
         { cache => $old_cache, expires_on => str2time("2009/05/15 00:00:00") },
         { cache => $new_cache },
     ],
 });