File Coverage

blib/lib/Interact/Later.pm
Criterion Covered Total %
statement 49 57 85.9
branch 3 4 75.0
condition n/a
subroutine 14 17 82.3
pod 5 6 83.3
total 71 84 84.5


line stmt bran cond sub pod time code
1             package Interact::Later;
2              
3 1     1   559124 use 5.020;
  1         4  
4 1     1   7 use strict;
  1         2  
  1         21  
5 1     1   4 use warnings;
  1         2  
  1         29  
6              
7              
8 1     1   6 use Storable qw( store retrieve );
  1         18  
  1         64  
9 1     1   448 use Path::Class qw/dir/;
  1         9245  
  1         58  
10 1     1   575 use Moose;
  1         456508  
  1         7  
11 1     1   8158 use Data::UUID;
  1         706  
  1         65  
12 1     1   518 use File::Find::Rule;
  1         8313  
  1         7  
13 1     1   53 use Data::Printer;
  1         3  
  1         10  
14              
15 1     1   674 use experimental 'signatures';
  1         3519  
  1         6  
16 1     1   200 no if ( $] >= 5.018 ), 'warnings' => 'experimental';
  1         2  
  1         9  
17              
18             has 'cache_path' => (
19             is => 'ro',
20             isa => 'Str',
21             trigger => sub {
22              
23             # The trigger operate a transformation on the relative path that is passed
24             # as an argument.
25             # $_[0] is the new value
26             # $_[1] is the old value
27             # See https://stackoverflow.com/a/1415884/954777
28             $_[ 0 ]->{ cache_path } = dir( $_[ 1 ] )->absolute->stringify() . '/';
29             }
30             );
31              
32             has 'file_extension' => (
33             is => 'ro',
34             isa => 'Str'
35             );
36              
37 0     0 0 0 sub get_oldest_file_in_cache($self) {
  0         0  
  0         0  
38 0         0 my @files = File::Find::Rule
39             ->file
40             ->name( '*' . $self->file_extension );
41              
42             # https://stackoverflow.com/a/7585306/954777
43             }
44              
45 0     0 1 0 sub release_cache($id) { }
  0         0  
46              
47 2     2 1 13975 sub clean_cache($self) {
  2         7  
  2         4  
48 2         73 while ( glob $self->cache_path . '*' . $self->file_extension ) {
49 1001 50       80316 unlink $_ or warn("Can't remove $_: $!");
50             }
51              
52             }
53              
54             sub generate_uuid {
55 1001     1001 1 679527 my $uuid = Data::UUID->new->create_str();
56 1001         777149 return $uuid;
57             }
58              
59 1001     1001 1 5901134 sub write_data_to_disk ( $self, $data ) {
  1001         3105  
  1001         2477  
  1001         1830  
60 1001 100       50969 if ( not -d $self->cache_path ) {
61 1         47 mkdir $self->cache_path;
62 1         69 say 'created cache directory';
63             }
64 1001         4819 my $uuid = generate_uuid();
65 1001         54492 store \$data, $self->cache_path . $uuid . $self->file_extension;
66 1001         199092 return $uuid;
67             }
68              
69 0     0 1   sub retrieve_data_from_disk($id) {
  0            
70              
71             }
72              
73              
74             =encoding UTF-8
75              
76             =head1 NAME
77              
78             Interact::Later - Delay some tasks for later by dumping their data to disk
79              
80             =head1 VERSION
81              
82             Version 0.04
83              
84             =cut
85              
86             our $VERSION = '0.04';
87              
88              
89             =head1 SYNOPSIS
90              
91             Can be used, for example, when you receive lots of C<POST> requests that you
92             don't want to proceed right now to save database load.
93              
94             This module will fastly store the data content on disk (with L<Storable>) without
95             the need to use a database or a job queue. I believe as Perl is fast at writing
96             files to disk, we can hope good results. This is an experiment...
97              
98              
99             use Interact::Later;
100              
101             my $delayer = Interact::Later->new(
102             cache_path => 'path/to/cache',
103             file_extension => '.dmp'
104             );
105              
106             $delayer->write_data_to_disk($data);
107              
108             # Later...
109             # Do it until there are no more files...
110             $delayer->get_oldest_file_in_cache();
111              
112             # Finally
113             $delayer->clean_cache;
114              
115             =head1 MOTIVATIONS
116              
117             TODO Telling the story of what happened at work and the situation with
118             databases, job queues, etc. that got troubled by the large amount of POST
119             requests.
120              
121             =head1 EXPORT
122              
123             A list of functions that can be exported. You can delete this section
124             if you don't export anything, such as for a purely object-oriented module.
125              
126             =head1 ATTRIBUTES
127              
128             To instantiate a new C<Interacter::Later> delayer, simply pass a hashref
129             containing a key-value couple containing the following:
130              
131             =head2 cache_path
132              
133             C<cache_path> is the relative path to the directory that will contain multiple
134             cache files. It will be expanded to an absolute path by the L<Moose> trigger and
135             L<Path::Class>.
136              
137             Keep it simple, it don't require a C</> in the beginning nor the end, and you
138             will be able to access it through C<$delayer->class_path>.
139              
140             $ pwd
141             /home/smonff/later/
142              
143             my $delayer = Interact::Later->new( cache_path => 'path/to/cache', ... );
144             say $delayer->class_path;
145             # /home/smonff/later/path/to/cache/
146             # Note it add a / in the end
147              
148             =head2 file_extension
149              
150             TODO
151              
152             =head1 SUBROUTINES/METHODS
153              
154             =head2 get_oldest_file_in_the_cache
155              
156             Retrieve the oldest file in the cache.
157              
158             =head2 clean_cache
159              
160             Flush the cache.
161              
162             =head2 release_cache
163              
164             Retrieve a specific file by ID
165              
166             =head2 generate_uuid
167              
168             =head2 write_data_to_disk
169              
170             Writes the cache files to disk using C<Storable>. It also checks that the cache
171             path exists and if not, it creates it.
172              
173             Returns the UUID so this way, the caller could re-use it (by placing it in a
174             queue for example).
175              
176              
177             =head2 retrieve_data_from_disk
178              
179              
180             =head1 AUTHOR
181              
182             Sébastien Feugère, C<< <smonff at riseup.net> >>
183              
184             =head1 BUGS
185              
186             Please report any bugs or feature requests to C<interact-later at gitlab.com>, or through
187             the web interface at L<https://gitlab.com/smonff/interact-later/issues>. I will be notified, and then you'll
188             automatically be notified of progress on your bug as I make changes.
189              
190              
191              
192              
193             =head1 SUPPORT
194              
195             You can find documentation for this module with the perldoc command.
196              
197             perldoc Interact::Later
198              
199              
200             You can also look for information at:
201              
202             =over 4
203              
204             =item * Gitlab: Gitlab issues tracker (report bugs here)
205              
206             L<http://gitlab.com/smonff/Interact-Later>
207              
208             =item * AnnoCPAN: Annotated CPAN documentation
209              
210             L<http://annocpan.org/dist/Interact-Later>
211              
212             =item * CPAN Ratings
213              
214             L<http://cpanratings.perl.org/d/Interact-Later>
215              
216             =item * Search CPAN
217              
218             L<http://search.cpan.org/dist/Interact-Later/>
219              
220             =back
221              
222              
223             =head1 ACKNOWLEDGEMENTS
224              
225              
226             =head1 LICENSE AND COPYRIGHT
227              
228             Copyright 2019 Sébastien Feugère.
229              
230             This program is free software; you can redistribute it and/or modify it
231             under the terms of the the Artistic License (2.0). You may obtain a
232             copy of the full license at:
233              
234             L<http://www.perlfoundation.org/artistic_license_2_0>
235              
236             Any use, modification, and distribution of the Standard or Modified
237             Versions is governed by this Artistic License. By using, modifying or
238             distributing the Package, you accept this license. Do not use, modify,
239             or distribute the Package, if you do not accept this license.
240              
241             If your Modified Version has been derived from a Modified Version made
242             by someone other than you, you are nevertheless required to ensure that
243             your Modified Version complies with the requirements of this license.
244              
245             This license does not grant you the right to use any trademark, service
246             mark, tradename, or logo of the Copyright Holder.
247              
248             This license includes the non-exclusive, worldwide, free-of-charge
249             patent license to make, have made, use, offer to sell, sell, import and
250             otherwise transfer the Package with respect to any patent claims
251             licensable by the Copyright Holder that are necessarily infringed by the
252             Package. If you institute patent litigation (including a cross-claim or
253             counterclaim) against any party alleging that the Package constitutes
254             direct or contributory patent infringement, then this Artistic License
255             to you shall terminate on the date that such litigation is filed.
256              
257             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
258             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
259             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
260             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
261             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
262             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
263             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
264             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
265              
266              
267             =cut
268              
269             1; # End of Interact::Later