/
Event.pm
228 lines (174 loc) · 5.2 KB
/
Event.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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
=head1 NAME
EPrints::Plugin::Event
=for Pod2Wiki
=head1 DESCRIPTION
Event plugins are called by the indexer to actually do work. L<EPrints::DataObj::EventQueue> objects are stored in the database and executed once their start_time is due. The object contains the plugin ID, action and optionally parameters.
Action is the sub called on the plugin. This sub must return undef or a valid response constant recognised by L<EPrints::DataObj::EventQueue/execute>.
Parameters can contain any Perl data structure that can be serialised by L<Storable>. As a special case parameters that look like an internal id are re-instantiated as the referenced object before the plugin action is called.
Events also support scheduled (or repeating) events by calling L</cron> on this class with the actual plugin id/action/parameters to call. The scheduled event isn't called directly but is triggered via a new event object with a start_time of now.
=head1 SYNOPSIS
EPrints::DataObj::EventQueue->create_unique( $repo, {
pluginid => "Event::Hello",
action => "hello",
params => ["John Smith"],
});
EPrints::DataObj::EventQueue->create_unique( $repo, {
pluginid => "Event",
action => "cron",
params => ["0,15,30,45 * * * *",
"Event::Hello",
"hello",
"John Smith",
],
});
=cut
package EPrints::Plugin::Event;
@ISA = qw( EPrints::Plugin );
use strict;
my @RANGES = (
"0-59",
"0-23",
"1-31",
"1-12",
"0-6",
);
sub new
{
my( $class, %params ) = @_;
$params{visible} = exists $params{visible} ? $params{visible} : "all";
$params{advertise} = exists $params{advertise} ? $params{advertise} : 1;
return $class->SUPER::new(%params);
}
# debug utility, just log whatever the parameters are
sub echo
{
my( $class, @params ) = @_;
for(@params)
{
$_ = $_->internal_uri if UNIVERSAL::isa( $_, "EPrints::DataObj" );
}
warn join ', ', @params;
return;
}
sub cron
{
my( $self, $time_spec, $pluginid, $action, @params ) = @_;
my $event = $self->{event};
# queue the actual action
EPrints::DataObj::EventQueue->create_unique( $self->{session}, {
pluginid => $pluginid,
action => $action,
params => \@params,
});
my $next_t = $self->_next_execution_time( $time_spec );
$event->set_value( "start_time", EPrints::Time::iso_datetime( $next_t ) );
return EPrints::Const::HTTP_RESET_CONTENT;
}
sub _next_execution_time
{
my( $self, $time_spec ) = @_;
my @entry = split /\s+/, $time_spec;
Carp::croak( "Error in $time_spec: expected 5 entries but got ".@entry )
if @entry != 5;
local $_;
my $i = 0;
for(@entry)
{
$_ = $RANGES[$i] if $_ eq '*';
$_ =~ s/([0-9]{1,2})-([0-9]{1,2})/join(',',$1 .. $2)/eg;
$_ = {
map { $_ => 1 }
split /,/, $_
};
$i++;
}
my $next_t = time();
$next_t -= $next_t % 60;
$next_t += 60;
# this algorithm increments $next_t until it is an acceptable value for the
# cron entry
# for better efficiency it increments by the largest non-matching criteria
# (e.g. a month if the current month is no good)
while(_increment( $next_t, @entry ))
{
EPrints->abort( "Out of cron range" )
if $next_t > time() + 31622400;
}
return $next_t;
}
# return true if we incremented $t
sub _increment
{
my( $t, @entry ) = @_;
# @entry[0] = hash of minutes to run
# @entry[1] = " hours to run
# [2] = " days of month
# [3] = " months to run
# [4] = " days of week to run
my @t = (gmtime($t))[0..7];
$t[4]++; # month
# month: if this month isn't in the months we should run
# increment to midnight of the start of next month.
if( !exists $entry[3]{$t[4]} )
{
$_[0] -= 86400 * ($t[3] - 1);
$_[0] -= $_[0] % 86400;
if( $t[4] == 12 )
{
@t = (gmtime($_[0]))[0..7];
$t[4] = 0; # month
$t[5]++; # year
$_[0] = Time::Local::timegm(@t);
}
else
{
@t = (gmtime($_[0]))[0..7];
$t[4]++; # month
$_[0] = Time::Local::timegm(@t);
}
return 1;
}
# day of week / day of month
# if today isn't a day of the week we should run
# OR
# today isn't a day of the month we should run
# increment to tomorrow.
if( !exists $entry[4]{$t[6]} || !exists $entry[2]{$t[3]} )
{
$_[0] -= $_[0] % 86400;
$_[0] += 86400;
return 1;
}
# hour: if this hour isn't an hour we should run, increment to the next hour
if( !exists $entry[1]{$t[2]} )
{
$_[0] -= $_[0] % 3600;
$_[0] += 3600;
return 1;
}
# minute
if( !exists $entry[0]{$t[1]} )
{
$_[0] += 60;
return 1;
}
return 0;
}
1;
=head1 COPYRIGHT
=for COPYRIGHT BEGIN
Copyright 2000-2011 University of Southampton.
=for COPYRIGHT END
=for LICENSE BEGIN
This file is part of EPrints L<http://www.eprints.org/>.
EPrints is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
EPrints is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
License for more details.
You should have received a copy of the GNU Lesser General Public
License along with EPrints. If not, see L<http://www.gnu.org/licenses/>.
=for LICENSE END