-
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Cached.pm
170 lines (117 loc) · 3.61 KB
/
Cached.pm
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
package Class::Simple::Cached;
use strict;
use warnings;
use Carp;
use Class::Simple;
my @ISA = ('Class::Simple');
=head1 NAME
Class::Simple::Cached - cache messages to an object
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SYNOPSIS
A sub-class of L<Class::Simple> which caches calls to read
the status of an object that are otherwise expensive.
It is up to the caller to maintain the cache if the object comes out of sync with the cache,
for example by changing its state.
=head1 SUBROUTINES/METHODS
=head2 new
Creates a Class::Simple::Cached object.
It takes one mandatory parameter: cache,
which is an object which understands get() and set() calls,
such as an L<CHI> object.
It takes one optional argument: object,
which is an object which is taken to be the object to be cached.
If not given, an object of the class L<Class::Simple> is instantiated
and that is used.
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
return unless(defined($class));
my %args;
if(ref($_[0]) eq 'HASH') {
%args = %{$_[0]};
} elsif(ref($_[0])) {
Carp::carp('Usage: ', __PACKAGE__, '->new(cache => $cache [, object => $object ], %args)');
return;
} elsif(@_ % 2 == 0) {
%args = @_;
}
if(!defined($args{'object'})) {
$args{'object'} = Class::Simple->new(%args);
}
if($args{'cache'}) {
return bless \%args, $class;
}
Carp::carp('Usage: ', __PACKAGE__, '->new(cache => $cache [, object => $object ], %args)');
}
sub _caller_class
{
my $self = shift;
if(ref($self->{'object'}) eq 'Class::Simple') {
# return $self->SUPER::_caller_class(@_);
return $self->Class::Simple::_caller_class(@_);
}
}
sub AUTOLOAD {
our $AUTOLOAD;
my $param = $AUTOLOAD;
$param =~ s/.*:://;
return if($param eq 'DESTROY');
my $self = shift;
# my $func = $self->{'object'} . "::$param";
my $func = $param;
my $object = $self->{'object'};
if($param !~ /^[gs]et_/) {
my $cache = $self->{'cache'};
if(scalar(@_) == 0) {
if(my $rc = $cache->get($param)) {
return $rc;
}
}
# $param = "SUPER::$param";
# return $cache->set($param, $self->$param(@_), 'never');
return $cache->set($param, $object->$func(@_), 'never');
}
# $param = "SUPER::$param";
$object->$func(@_);
}
=head1 AUTHOR
Nigel Horne, C<< <njh at bandsman.co.uk> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-class-simple-cached at rt.cpan.org>,
or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Simple-Cached>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
params() returns a ref which means that calling routines can change the hash
for other routines.
Take a local copy before making amendments to the table if you don't want unexpected
things to happen.
=head1 SEE ALSO
L<Class::Simple>, L<CHI>
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Class::Simple::Cached
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Simple-Cached>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Class-Simple-Cached>
=item * Search CPAN
L<http://search.cpan.org/dist/Class-Simple-Cached/>
=back
=head1 LICENSE AND COPYRIGHT
Author Nigel Horne: C<njh@bandsman.co.uk>
Copyright (C) 2019, Nigel Horne
Usage is subject to licence terms.
The licence terms of this software are as follows:
Personal single user, single computer use: GPL2
All other users (including Commercial, Charity, Educational, Government)
must apply in writing for a licence for use from Nigel Horne at the
above e-mail.
=cut
1;