← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:23 2013

Filename/home/ocbnet/domain/ocbnet.ch/vhost/webmerge/htdocs/webmerge/scripts/modules/RTP/Webmerge/Watchdog.pm
StatementsExecuted 22 statements in 7.11ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.33ms73.2msRTP::Webmerge::Watchdog::::BEGIN@30RTP::Webmerge::Watchdog::BEGIN@30
111106µs405µsRTP::Webmerge::Watchdog::::BEGIN@12RTP::Webmerge::Watchdog::BEGIN@12
11180µs265µsRTP::Webmerge::Watchdog::::BEGIN@33RTP::Webmerge::Watchdog::BEGIN@33
11160µs250µsRTP::Webmerge::Watchdog::::BEGIN@36RTP::Webmerge::Watchdog::BEGIN@36
11157µs90µsRTP::Webmerge::Watchdog::::BEGIN@14RTP::Webmerge::Watchdog::BEGIN@14
11156µs230µsRTP::Webmerge::Watchdog::::BEGIN@39RTP::Webmerge::Watchdog::BEGIN@39
11156µs56µsRTP::Webmerge::Watchdog::::BEGIN@22.26RTP::Webmerge::Watchdog::BEGIN@22.26
11155µs145µsRTP::Webmerge::Watchdog::::BEGIN@13RTP::Webmerge::Watchdog::BEGIN@13
11144µs44µsRTP::Webmerge::Watchdog::::BEGIN@25RTP::Webmerge::Watchdog::BEGIN@25
11124µs24µsRTP::Webmerge::Watchdog::::BEGIN@22RTP::Webmerge::Watchdog::BEGIN@22
11123µs23µsRTP::Webmerge::Watchdog::::BEGIN@19RTP::Webmerge::Watchdog::BEGIN@19
11112µs12µsRTP::Webmerge::Watchdog::::ENDRTP::Webmerge::Watchdog::END
0000s0sRTP::Webmerge::Watchdog::::__ANON__[:249]RTP::Webmerge::Watchdog::__ANON__[:249]
0000s0sRTP::Webmerge::Watchdog::::__ANON__[:92]RTP::Webmerge::Watchdog::__ANON__[:92]
0000s0sRTP::Webmerge::Watchdog::::childRTP::Webmerge::Watchdog::child
0000s0sRTP::Webmerge::Watchdog::::motherRTP::Webmerge::Watchdog::mother
0000s0sRTP::Webmerge::Watchdog::::watchdogRTP::Webmerge::Watchdog::watchdog
Call graph for these subroutines as a Graphviz dot language file.
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###################################################################################################
5package 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
122178µs2705µ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
use Carp;
# spent 405µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@12 # spent 299µs making 1 call to Exporter::import
132148µs2234µ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
use strict;
# spent 145µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@13 # spent 89µs making 1 call to strict::import
142199µs2122µ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
use warnings;
# 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
191148µs123µs
# spent 23µs within RTP::Webmerge::Watchdog::BEGIN@19 which was called: # once (23µs+0s) by main::BEGIN@37 at line 19
BEGIN { $RTP::Webmerge::Watcher::VERSION = "0.70" }
# spent 23µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@19
20
21# load exporter and inherit from it
223399µs280µs
# spent 24µs within RTP::Webmerge::Watchdog::BEGIN@22 which was called: # once (24µs+0s) by main::BEGIN@37 at line 22 # spent 56µs within RTP::Webmerge::Watchdog::BEGIN@22.26 which was called: # once (56µs+0s) by main::BEGIN@37 at line 22
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
251146µs144µs
# spent 44µs within RTP::Webmerge::Watchdog::BEGIN@25 which was called: # once (44µs+0s) by main::BEGIN@37 at line 25
BEGIN { our @EXPORT = qw(watchdog); }
# spent 44µs making 1 call to RTP::Webmerge::Watchdog::BEGIN@25
26
27###################################################################################################
28
29# load fork queue
302683µs173.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
use Fork::Queue qw();
# spent 73.2ms making 1 call to RTP::Webmerge::Watchdog::BEGIN@30
31
32# load function from core module
332189µs2450µ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
use List::MoreUtils qw(uniq);
# 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
362174µs2439µ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
use RTP::Webmerge::Path qw(check_path exportURI);
# 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
3924.80ms2404µ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
use RTP::Webmerge::Merge qw(merge);
# 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
4413µsmy ($child_pid, $mother_pid);
45
46###################################################################################################
47
48# watch for file changes
49# pass them to our child
50sub 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
104sub 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
207sub 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
327END
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
{
329124µ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###################################################################################################
343116µs1;
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.