Filename | /home/ocbnet/domain/ocbnet.ch/vhost/webmerge/htdocs/webmerge/scripts/modules/RTP/Webmerge/Watchdog.pm |
Statements | Executed 22 statements in 7.11ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 3.33ms | 73.2ms | BEGIN@30 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 106µs | 405µs | BEGIN@12 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 80µs | 265µs | BEGIN@33 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 60µs | 250µs | BEGIN@36 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 57µs | 90µs | BEGIN@14 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 56µs | 230µs | BEGIN@39 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 56µs | 56µs | BEGIN@22.26 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 55µs | 145µs | BEGIN@13 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 44µs | 44µs | BEGIN@25 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 24µs | 24µs | BEGIN@22 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 23µs | 23µs | BEGIN@19 | RTP::Webmerge::Watchdog::
1 | 1 | 1 | 12µs | 12µs | END | RTP::Webmerge::Watchdog::
0 | 0 | 0 | 0s | 0s | __ANON__[:249] | RTP::Webmerge::Watchdog::
0 | 0 | 0 | 0s | 0s | __ANON__[:92] | RTP::Webmerge::Watchdog::
0 | 0 | 0 | 0s | 0s | child | RTP::Webmerge::Watchdog::
0 | 0 | 0 | 0s | 0s | mother | RTP::Webmerge::Watchdog::
0 | 0 | 0 | 0s | 0s | watchdog | RTP::Webmerge::Watchdog::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | ################################################################################################### | ||||
2 | # Copyright 2013 by Marcel Greter | ||||
3 | # This file is part of Webmerge (GPL3) | ||||
4 | ################################################################################################### | ||||
5 | package RTP::Webmerge::Watchdog; | ||||
6 | ################################################################################################### | ||||
7 | # maybe improve child handling, atm we leave zoombies | ||||
8 | # when the mother process gets killed hard by SIGKILL | ||||
9 | # use Linux::Prctl; prctl(PR_SET_PDEATHSIG, SIGHUP); | ||||
10 | ################################################################################################### | ||||
11 | |||||
12 | 2 | 178µs | 2 | 705µs | # spent 405µs (106+299) within RTP::Webmerge::Watchdog::BEGIN@12 which was called:
# once (106µs+299µs) by main::BEGIN@37 at line 12 # spent 405µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@12
# spent 299µs making 1 call to Exporter::import |
13 | 2 | 148µs | 2 | 234µs | # spent 145µs (55+89) within RTP::Webmerge::Watchdog::BEGIN@13 which was called:
# once (55µs+89µs) by main::BEGIN@37 at line 13 # spent 145µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@13
# spent 89µs making 1 call to strict::import |
14 | 2 | 199µs | 2 | 122µs | # spent 90µs (57+33) within RTP::Webmerge::Watchdog::BEGIN@14 which was called:
# once (57µs+33µs) by main::BEGIN@37 at line 14 # spent 90µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@14
# spent 33µs making 1 call to warnings::import |
15 | |||||
16 | ################################################################################################### | ||||
17 | |||||
18 | # define our version string | ||||
19 | 1 | 148µs | 1 | 23µs | # spent 23µs within RTP::Webmerge::Watchdog::BEGIN@19 which was called:
# once (23µs+0s) by main::BEGIN@37 at line 19 # spent 23µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@19 |
20 | |||||
21 | # load exporter and inherit from it | ||||
22 | 3 | 399µs | 2 | 80µs | BEGIN { use Exporter qw(); our @ISA = qw(Exporter) } # spent 56µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@22.26
# spent 24µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@22 |
23 | |||||
24 | # define our functions to be exported | ||||
25 | 1 | 146µs | 1 | 44µs | # spent 44µs within RTP::Webmerge::Watchdog::BEGIN@25 which was called:
# once (44µs+0s) by main::BEGIN@37 at line 25 # spent 44µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@25 |
26 | |||||
27 | ################################################################################################### | ||||
28 | |||||
29 | # load fork queue | ||||
30 | 2 | 683µs | 1 | 73.2ms | # spent 73.2ms (3.33+69.9) within RTP::Webmerge::Watchdog::BEGIN@30 which was called:
# once (3.33ms+69.9ms) by main::BEGIN@37 at line 30 # spent 73.2ms making 1 call to RTP::Webmerge::Watchdog::BEGIN@30 |
31 | |||||
32 | # load function from core module | ||||
33 | 2 | 189µs | 2 | 450µs | # spent 265µs (80+185) within RTP::Webmerge::Watchdog::BEGIN@33 which was called:
# once (80µs+185µs) by main::BEGIN@37 at line 33 # spent 265µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@33
# spent 185µs making 1 call to Exporter::import |
34 | |||||
35 | # load core webmerge path functions | ||||
36 | 2 | 174µs | 2 | 439µs | # spent 250µs (60+189) within RTP::Webmerge::Watchdog::BEGIN@36 which was called:
# once (60µs+189µs) by main::BEGIN@37 at line 36 # spent 250µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@36
# spent 189µs making 1 call to Exporter::import |
37 | |||||
38 | # load merge function to call on file change | ||||
39 | 2 | 4.80ms | 2 | 404µs | # spent 230µs (56+174) within RTP::Webmerge::Watchdog::BEGIN@39 which was called:
# once (56µs+174µs) by main::BEGIN@37 at line 39 # spent 230µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@39
# spent 174µs making 1 call to Exporter::import |
40 | |||||
41 | ################################################################################################### | ||||
42 | |||||
43 | # declare package variables | ||||
44 | 1 | 3µs | my ($child_pid, $mother_pid); | ||
45 | |||||
46 | ################################################################################################### | ||||
47 | |||||
48 | # watch for file changes | ||||
49 | # pass them to our child | ||||
50 | sub mother ($$$$$) | ||||
51 | { | ||||
52 | |||||
53 | # get input variables | ||||
54 | my ($config, $queue, $blocks, $path2id, $id2path) = @_; | ||||
55 | |||||
56 | # try to load the watch module conditional | ||||
57 | unless (eval { require Filesys::Notify::Simple; 1 }) | ||||
58 | { die "module Filesys::Notify::Simple not found"; } | ||||
59 | |||||
60 | # create the watcher object on all filepaths | ||||
61 | my $watcher = Filesys::Notify::Simple->new([keys %{$path2id}]); | ||||
62 | |||||
63 | # print delimiter line | ||||
64 | print '#' x 78, "\n"; | ||||
65 | |||||
66 | # print a debug message to the console | ||||
67 | print "Started watchdog, waiting for file changes ...\n"; | ||||
68 | |||||
69 | # print delimiter line | ||||
70 | print '#' x 78, "\n"; | ||||
71 | |||||
72 | # go into endless loop | ||||
73 | while (1) | ||||
74 | { | ||||
75 | |||||
76 | # watch for file changes | ||||
77 | # this will block forever | ||||
78 | $watcher->wait(sub | ||||
79 | { | ||||
80 | |||||
81 | # get all file events | ||||
82 | for my $event (@_) | ||||
83 | { | ||||
84 | # get the normalized path string | ||||
85 | my $path = check_path($event->{path}); | ||||
86 | # enqueue our merge block key (string) to child | ||||
87 | $queue->enqueue($path2id->{$path}); | ||||
88 | |||||
89 | } | ||||
90 | # EO all events | ||||
91 | |||||
92 | }); | ||||
93 | # EO wait for watcher | ||||
94 | |||||
95 | }; | ||||
96 | # EO endless loop | ||||
97 | |||||
98 | }; | ||||
99 | # EO sub mother | ||||
100 | |||||
101 | ################################################################################################### | ||||
102 | |||||
103 | # process passed items | ||||
104 | sub child ($$$$$) | ||||
105 | { | ||||
106 | |||||
107 | # store mother pid | ||||
108 | $child_pid = $$; | ||||
109 | |||||
110 | # get input variables | ||||
111 | my ($config, $queue, $blocks, $path2id, $id2path) = @_; | ||||
112 | |||||
113 | # local queue | ||||
114 | my (@queue); | ||||
115 | |||||
116 | # go into endless loop | ||||
117 | while (1) | ||||
118 | { | ||||
119 | |||||
120 | # check if we have something to | ||||
121 | # dequeue in the next seconds | ||||
122 | if ($queue->can_dequeue(0.5)) | ||||
123 | { | ||||
124 | |||||
125 | # dequeue a key from notifier | ||||
126 | my $item = $queue->dequeue(); | ||||
127 | |||||
128 | # wait for exit command | ||||
129 | exit if $item eq "stop"; | ||||
130 | |||||
131 | # push the real hash to the queue | ||||
132 | push(@queue, $item); | ||||
133 | |||||
134 | # make the queue unique | ||||
135 | @queue = uniq @queue; | ||||
136 | |||||
137 | } | ||||
138 | # nothing to dequeue, idle | ||||
139 | else | ||||
140 | { | ||||
141 | |||||
142 | next if scalar(@queue) == 0; | ||||
143 | |||||
144 | # print a debug message to the console about changed files | ||||
145 | print "file changed: ", exportURI($id2path->{$_}), "\n" foreach (@queue); | ||||
146 | |||||
147 | # print delimiter line if something to do | ||||
148 | print '#' x 78, "\n"; | ||||
149 | |||||
150 | # resolve to merge blocks and remove duplicates | ||||
151 | my @todo = uniq map { @{$blocks->[$_]} } @queue; | ||||
152 | |||||
153 | # process each merge block | ||||
154 | while (my $merge = shift @todo) | ||||
155 | { | ||||
156 | |||||
157 | # get some vars from hash | ||||
158 | my $type = $merge->{'type'}; | ||||
159 | my $block = $merge->{'block'}; | ||||
160 | |||||
161 | # change directory (restore previous state after this block) | ||||
162 | my $block_dir = RTP::Webmerge::Path->chdir($block->{'chdir'}); | ||||
163 | |||||
164 | # change directory (restore previous state after this block) | ||||
165 | my $merge_dir = RTP::Webmerge::Path->chdir($merge->{'chdir'}); | ||||
166 | |||||
167 | # now dispatch to merge this entry in eval | ||||
168 | eval { merge($config, $merge, $type); }; | ||||
169 | |||||
170 | # check if eval had an error | ||||
171 | print $@ if $@; | ||||
172 | |||||
173 | } | ||||
174 | # EO if can dequeue | ||||
175 | |||||
176 | # reset atomic operations | ||||
177 | # this will commit all changes | ||||
178 | $config->{'atomic'} = {}; | ||||
179 | |||||
180 | # delete all temporarily created files | ||||
181 | foreach (@{$config->{'temps'} || []}) | ||||
182 | { unlink $_ if -e $_; } | ||||
183 | |||||
184 | # reset temporarily files | ||||
185 | $config->{'temps'} = []; | ||||
186 | |||||
187 | # ring the bell | ||||
188 | print "\a"; | ||||
189 | # clear queue | ||||
190 | undef @queue; | ||||
191 | # print delimiter line | ||||
192 | print '#' x 78, "\n"; | ||||
193 | |||||
194 | } | ||||
195 | # EO can dequeue | ||||
196 | |||||
197 | } | ||||
198 | # EO endless loop | ||||
199 | |||||
200 | }; | ||||
201 | # EO sub child | ||||
202 | |||||
203 | ################################################################################################### | ||||
204 | |||||
205 | # main watchdog function | ||||
206 | # forks mother and child | ||||
207 | sub watchdog | ||||
208 | { | ||||
209 | |||||
210 | # get configuration | ||||
211 | my ($config) = @_; | ||||
212 | |||||
213 | # files to watch | ||||
214 | my (%files, @files, %path2id, %id2path); | ||||
215 | |||||
216 | # get xml settings object | ||||
217 | my $xml = $config->{'xml'}; | ||||
218 | |||||
219 | # store mother pid | ||||
220 | $mother_pid = $$; | ||||
221 | |||||
222 | # do not wait for children | ||||
223 | local $SIG{CHLD} = 'IGNORE'; | ||||
224 | |||||
225 | # hook into termination signal | ||||
226 | # this is the default sent by kill | ||||
227 | local $SIG{INT} = | ||||
228 | local $SIG{TERM} = | ||||
229 | sub | ||||
230 | { | ||||
231 | |||||
232 | # this is the mother process | ||||
233 | if ($mother_pid == $$) | ||||
234 | { | ||||
235 | # print "ABORTED MOTHER PROCESS\n"; | ||||
236 | # print "GOING TO KILL $child_pid\n"; | ||||
237 | kill 'TERM', $child_pid; | ||||
238 | exit; | ||||
239 | } | ||||
240 | # this is the child process | ||||
241 | elsif ($mother_pid != $$) | ||||
242 | { | ||||
243 | # print "ABORTED CHILD PROCESS\n"; | ||||
244 | # print "GOING TO KILL $mother_pid\n"; | ||||
245 | kill 'TERM', $mother_pid; | ||||
246 | exit; | ||||
247 | } | ||||
248 | |||||
249 | }; | ||||
250 | # EO sig term handler | ||||
251 | |||||
252 | # loop all merge blocks within xml settings | ||||
253 | foreach my $block (@{$xml->{'merge'} || []}) | ||||
254 | { | ||||
255 | |||||
256 | # change directory (restore previous state after this block) | ||||
257 | my $dir = RTP::Webmerge::Path->chdir($block->{'chdir'}); | ||||
258 | |||||
259 | # loop all possible merge types | ||||
260 | foreach my $type ('js', 'css') | ||||
261 | { | ||||
262 | |||||
263 | # loop all inner merge blocks (by given type) | ||||
264 | foreach my $merge (@{$block->{$type} || []}) | ||||
265 | { | ||||
266 | |||||
267 | # change directory (restore previous state after this block) | ||||
268 | my $dir = RTP::Webmerge::Path->chdir($merge->{'chdir'}); | ||||
269 | |||||
270 | # loop all input elements to watch for | ||||
271 | foreach my $input (@{$merge->{'input'} || []}) | ||||
272 | { | ||||
273 | |||||
274 | # attach some variables | ||||
275 | $merge->{'type'} = $type; | ||||
276 | $merge->{'block'} = $block; | ||||
277 | |||||
278 | # resolve the input path | ||||
279 | my $path = check_path($input->{'path'}); | ||||
280 | |||||
281 | # create array by filepath if it does not exist | ||||
282 | $files{$path} = [] unless exists $files{$path}; | ||||
283 | |||||
284 | # push merge block to this path | ||||
285 | push(@{$files{$path}}, $merge); | ||||
286 | |||||
287 | # make the merge blocks unique for path | ||||
288 | @{$files{$path}} = uniq @{$files{$path}}; | ||||
289 | |||||
290 | } | ||||
291 | # EO foreach input tag | ||||
292 | |||||
293 | } | ||||
294 | # EO foreach merge tag | ||||
295 | |||||
296 | } | ||||
297 | # EO foreach merge type | ||||
298 | |||||
299 | } | ||||
300 | # EO foreach merge block | ||||
301 | |||||
302 | # create file array and lookup index | ||||
303 | foreach my $path (keys %files) | ||||
304 | { | ||||
305 | # define the lookup index | ||||
306 | $path2id{$path} = scalar(@files); | ||||
307 | $id2path{$path2id{$path}} = $path; | ||||
308 | # add merge blocks by index | ||||
309 | push (@files, $files{$path}); | ||||
310 | } | ||||
311 | # EO each file path | ||||
312 | |||||
313 | # create a new queue object | ||||
314 | # used to pass commands around | ||||
315 | my $queue = Fork::Queue->new(); | ||||
316 | |||||
317 | # start child process | ||||
318 | if ($child_pid = fork()) | ||||
319 | { mother($config, $queue, \@files, \%path2id, \%id2path); } | ||||
320 | else { child($config, $queue, \@files, \%path2id, \%id2path); } | ||||
321 | |||||
322 | } | ||||
323 | # EO sub watchdog | ||||
324 | |||||
325 | ################################################################################################### | ||||
326 | |||||
327 | END | ||||
328 | # spent 12µs within RTP::Webmerge::Watchdog::END which was called:
# once (12µs+0s) by main::RUNTIME at line 0 of webmerge/scripts/webmerge.pl | ||||
329 | 1 | 24µs | if ($mother_pid && $mother_pid == $$) | ||
330 | { | ||||
331 | # make sure child is terminated | ||||
332 | kill 'TERM', $child_pid if $child_pid; | ||||
333 | } | ||||
334 | elsif ($mother_pid && $mother_pid != $$) | ||||
335 | { | ||||
336 | # make sure mother is terminated | ||||
337 | kill 'TERM', $mother_pid if $mother_pid; | ||||
338 | } | ||||
339 | } | ||||
340 | |||||
341 | ################################################################################################### | ||||
342 | ################################################################################################### | ||||
343 | 1 | 16µs | 1; |