File Coverage

blib/lib/Monitoring/TT.pm
Criterion Covered Total %
statement 83 450 18.4
branch 15 176 8.5
condition 2 33 6.0
subroutine 15 35 42.8
pod 3 3 100.0
total 118 697 16.9


line stmt bran cond sub pod time code
1             package Monitoring::TT;
2              
3 4     4   3422 use strict;
  4         10  
  4         144  
4 4     4   20 use warnings;
  4         7  
  4         119  
5 4     4   4009 use utf8;
  4         42  
  4         33  
6 4     4   4024 use Pod::Usage;
  4         208334  
  4         591  
7 4     4   5386 use Getopt::Long;
  4         47571  
  4         27  
8 4     4   4598 use Template;
  4         89835  
  4         133  
9 4     4   2396 use Monitoring::TT::Identifier;
  4         13  
  4         208  
10 4     4   2285 use Monitoring::TT::Log qw/error warn info debug trace log/;
  4         12  
  4         402  
11 4     4   2480 use Monitoring::TT::Object;
  4         12  
  4         104  
12 4     4   1978 use Monitoring::TT::Render;
  4         11  
  4         108  
13 4     4   2020 use Monitoring::TT::Utils;
  4         11  
  4         21296  
14              
15             our $VERSION = '1.0.0';
16              
17             #####################################################################
18              
19             =head1 NAME
20              
21             Monitoring::TT - Generic Monitoring Config based on Template Toolkit Templates
22              
23             =head1 DESCRIPTION
24              
25             Generic Monitoring Config based on Template Toolkit Templates
26              
27             =cut
28              
29             #####################################################################
30              
31             =head1 CONSTRUCTOR
32              
33             =head2 new
34              
35             new(%options)
36              
37             =cut
38              
39             sub new {
40 3     3 1 2046 my($class, %options) = @_;
41 3         27 my $self = {
42             tt_opts => {
43             TRIM => 1,
44             RELATIVE => 1,
45             STAT_TTL => 60,
46             STRICT => 1,
47             }
48             };
49 3         10 bless $self, $class;
50              
51 3 50       20 $self->{'tt_opts'}->{'STRICT'} = 1 if $ENV{'TEST_AUTHOR'};
52 3 50       40 $self->{'tt_opts'}->{'STRICT'} = 1 if -f '.author';
53 3         5 for my $s (@{Monitoring::TT::Identifier::functions('Monitoring::TT::Render')}) {
  3         18  
54 42         49 $self->{'tt_opts'}->{'PRE_DEFINE'}->{$s} = \&{'Monitoring::TT::Render::'.$s};
  42         201  
55             }
56              
57 3         18 return $self;
58             }
59              
60             #####################################################################
61              
62             =head1 METHODS
63              
64             =head2 run
65              
66             run config generator and write it to the output folder
67              
68             =cut
69              
70             sub run {
71 0     0 1 0 my( $self ) = @_;
72 0 0       0 return unless $self->_get_options();
73 0         0 info('generating config from '.join(', ', @{$self->{'in'}}));
  0         0  
74 0         0 info('into '.$self->{'out'});
75 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
76 0 0       0 if(! -d $in.'/.') {
77 0         0 error($in.': '.$!);
78 0         0 exit 1;
79             }
80             }
81 0         0 $self->_run_hook('pre', join(',', @{$self->{'in'}}));
  0         0  
82              
83             # die if output directory already exists
84 0 0 0     0 if(-e $self->{'out'} and !$self->{'opt'}->{'force'}) {
85 0         0 my @files = glob($self->{'out'}.'/*');
86 0 0       0 if(scalar @files > 0) {
87 0         0 error($self->{'out'}.' does already exist and is not empty. (use --force to overwrite contents)');
88 0         0 exit 1;
89             }
90             }
91 0         0 $self->_mkdir_r($self->{'out'});
92              
93 0 0       0 info('using template filter: '.$self->{'opt'}->{'templatefilter'}) if $self->{'opt'}->{'templatefilter'};
94 0 0       0 info('using contact filter: '.$self->{'opt'}->{'contactfilter'}) if $self->{'opt'}->{'contactfilter'};
95 0 0       0 info('using host filter: '.$self->{'opt'}->{'hostfilter'}) if $self->{'opt'}->{'hostfilter'};
96              
97             # reset counter
98 0         0 $self->{'possible_types'} = {};
99 0         0 $self->{'possible_tags'} = {};
100 0         0 $self->{'possible_apps'} = {};
101              
102 0         0 $self->_copy_static_files();
103 0         0 $self->_build_dynamic_config();
104 0 0       0 $self->_check_typos() unless $self->{'opt'}->{'templatefilter'};
105 0 0       0 $self->_print_stats() if $Monitoring::TT::Log::Verbose >= 2;
106 0         0 $self->_run_hook('post', join(',', @{$self->{'in'}}));
  0         0  
107 0         0 info('done');
108 0         0 return 0;
109             }
110              
111             #####################################################################
112              
113             =head2 tt
114              
115             return template toolkit object
116              
117             =cut
118              
119             sub tt {
120 3     3 1 6 my($self) = @_;
121              
122 3 100       16 return $self->{'_tt'} if $self->{'_tt'};
123              
124             # make some globals available in TT stash
125 2         6 $self->{'tt_opts'}->{'PRE_DEFINE'}->{'src'} = $self->{'in'};
126              
127 2         31 $self->{'_tt'} = Template->new($self->{'tt_opts'});
128 2         81663 $Template::Stash::PRIVATE = undef;
129              
130 2         25 return $self->{'_tt'};
131             }
132              
133             #####################################################################
134             # INTERNAL SUBS
135             #####################################################################
136             sub _get_options {
137 0     0   0 my($self) = @_;
138 0         0 Getopt::Long::Configure('no_ignore_case');
139 0         0 Getopt::Long::Configure('bundling');
140 0         0 $self->{'opt'} = {
141             files => [],
142             verbose => 1,
143             force => 0,
144             dryrun => 0,
145             };
146             GetOptions (
147             'h|help' => \$self->{'opt'}->{'help'},
148 0     0   0 'v|verbose' => sub { $self->{'opt'}->{'verbose'}++ },
149             'q|quiet' => \$self->{'opt'}->{'quiet'},
150             'V|version' => \$self->{'opt'}->{'version'},
151             'f|force' => \$self->{'opt'}->{'force'},
152             'cf|contactfilter=s' => \$self->{'opt'}->{'contactfilter'},
153             'hf|hostfilter=s' => \$self->{'opt'}->{'hostfilter'},
154             'tf|templatefilter=s' => \$self->{'opt'}->{'templatefilter'},
155             'n|dry-run' => \$self->{'opt'}->{'dryrun'},
156 0     0   0 '<>' => sub { push @{$self->{'opt'}->{'files'}}, $_[0] },
  0         0  
157 0 0       0 ) or $self->_usage();
158 0 0       0 if($self->{'opt'}->{'version'}) { print 'Version ', $VERSION,"\n"; exit 0; }
  0         0  
  0         0  
159 0 0       0 pod2usage({ -verbose => 2, -exit => 3 } ) if $self->{'opt'}->{'help'};
160 0 0       0 $self->_usage('please specify at least one input and output folder!') if scalar @{$self->{'opt'}->{'files'}} <= 1;
  0         0  
161 0         0 for my $f (@{$self->{'opt'}->{'files'}}) { $f =~ s/\/*$//gmx; }
  0         0  
  0         0  
162 0         0 $self->{'out'} = pop @{$self->{'opt'}->{'files'}};
  0         0  
163 0         0 $self->{'in'} = $self->{'opt'}->{'files'};
164 0 0       0 $self->{'opt'}->{'verbose'} = 0 if $self->{'opt'}->{'quiet'};
165 0 0       0 $self->{'opt'}->{'dryrun'} = 1 if $self->{'opt'}->{'contactfilter'};
166 0 0       0 $self->{'opt'}->{'dryrun'} = 1 if $self->{'opt'}->{'hostfilter'};
167 0 0       0 $self->{'opt'}->{'dryrun'} = 1 if $self->{'opt'}->{'templatefilter'};
168 0         0 $Monitoring::TT::Log::Verbose = $self->{'opt'}->{'verbose'};
169 0 0       0 info('Dry Run, Hooks won\'t be executed') if $self->{'opt'}->{'dryrun'};
170 0         0 return 1;
171             }
172              
173             #####################################################################
174             sub _usage {
175 0     0   0 my($self, $msg) = @_;
176 0 0       0 print $msg, "\n\n" if $msg;
177 0         0 print "usage: $0 [options] [...] \ndetailed help available with --help\n";
178 0         0 exit 3;
179             }
180              
181             #####################################################################
182             sub _copy_static_files {
183 0     0   0 my($self) = @_;
184 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
185 0 0       0 if(-d $in.'/static/.') {
186 0         0 my $cmd = 'cp -LR '.$in.'/static/* '.$self->{'out'}.'/';
187 0         0 debug($cmd);
188 0         0 `$cmd`;
189             }
190             }
191 0         0 return;
192             }
193              
194             #####################################################################
195             sub _build_dynamic_config {
196 0     0   0 my($self) = @_;
197             # main work block, dynamic object configuration
198 0         0 $self->_build_dynamic_object_config();
199              
200             # other files
201 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
202 0         0 for my $file (sort glob($in.'/*.cfg')) {
203 0 0 0     0 next if defined $self->{'opt'}->{'templatefilter'} and $file !~ m/$self->{'opt'}->{'templatefilter'}/mx;
204 0         0 info('processing non object: '.$file);
205 0         0 my $outfile = $file;
206 0         0 $outfile =~ s/.*\///mx;
207 0 0       0 next if $outfile =~ m/^hosts.*\.cfg/gmx;
208 0 0       0 next if $outfile =~ m/^contacts.*\.cfg/gmx;
209 0         0 $outfile = $self->{'out'}.'/'.$outfile;
210 0         0 debug('writing: '.$outfile);
211 0 0       0 open(my $fh, '>', $outfile) or die('cannot write '.$outfile.': '.$!);
212 0         0 print $fh $self->_process_template($self->_read_replaced_template($file), {});
213 0         0 print $fh "\n";
214 0         0 close($fh);
215             }
216             }
217              
218 0         0 return;
219             }
220              
221             #####################################################################
222             # do the main work, this block is essential for maximum performance
223             sub _build_dynamic_object_config {
224 0     0   0 my($self) = @_;
225              
226             # build templates
227 0         0 my $templates = {
228             contacts => $self->_build_template('conf.d', 'contacts'),
229             hosts => $self->_build_template('conf.d', 'hosts', [ 'conf.d/apps', 'conf.d/apps.cfg' ]),
230             };
231              
232             # detect input type
233 0         0 my $input_types = $self->_get_input_types($self->{'in'});
234              
235             # no dynamic config at all?
236 0 0       0 return unless scalar keys %{$input_types} > 0;
  0         0  
237              
238 0         0 mkdir($self->{'out'}.'/conf.d');
239              
240 0         0 my $data = { hosts => [], contacts => []};
241 0         0 for my $type (keys %{$input_types}) {
  0         0  
242 0         0 my $typefilter = $self->{'opt'}->{substr($type,0,-1).'filter'};
243 0         0 my $obj_list = [];
244 0         0 trace('fetching data for '.$type);
245 0         0 for my $cls (@{$input_types->{$type}}) {
  0         0  
246 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
247 0         0 my $data = $cls->read($in, $type);
248 0         0 for my $d (@{$data}) {
  0         0  
249 0         0 $d->{'montt'} = $self;
250 0         0 my $o = Monitoring::TT::Object->new($type, $d);
251 0 0       0 die('got no object') unless defined $o;
252 0 0 0     0 next if defined $typefilter and join(',', values %{$o}) !~ m/$typefilter/mx;
  0         0  
253 0 0       0 trace($o) if $Monitoring::TT::Log::Verbose >= 5;
254 0         0 push @{$obj_list}, $o;
  0         0  
255             }
256             }
257             }
258             # sort objects by name
259 0         0 @{$obj_list} = sort {$a->{'name'} cmp $b->{'name'}} @{$obj_list};
  0         0  
  0         0  
  0         0  
260 0         0 $data->{$type} = $obj_list;
261              
262 0         0 my $outfile = $self->{'out'}.'/conf.d/'.$type.'.cfg';
263 0         0 info('writing: '.$outfile);
264 0 0       0 open(my $fh, '>', $outfile) or die('cannot write '.$outfile.': '.$!);
265 0         0 print $fh $self->_process_template($templates->{$type}, { type => $type, data => $obj_list });
266 0         0 print $fh "\n";
267 0         0 close($fh);
268             }
269              
270 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
271 0         0 for my $file (reverse sort @{$self->_get_files($in.'/conf.d', '\.cfg')}) {
  0         0  
272 0 0 0     0 next if defined $self->{'opt'}->{'templatefilter'} and $file !~ m/$self->{'opt'}->{'templatefilter'}/mx;
273 0 0       0 next if $file =~ m/^$in\/conf\.d\/apps/mx;
274 0 0       0 next if $file =~ m/^$in\/conf\.d\/contacts/mx;
275 0 0       0 next if $file =~ m/^$in\/conf\.d\/hosts/mx;
276 0         0 info('processing object file: '.$file);
277 0         0 my $outfile = $file;
278 0         0 $outfile =~ s/.*\///mx;
279 0         0 $outfile = $self->{'out'}.'/conf.d/'.$outfile;
280 0         0 debug('writing: '.$outfile);
281 0 0       0 open(my $fh, '>', $outfile) or die('cannot write '.$outfile.': '.$!);
282 0         0 print $fh $self->_process_template($self->_read_replaced_template($file), $data);
283 0         0 print $fh "\n";
284 0         0 close($fh);
285             }
286             }
287              
288 0         0 $self->{'data'} = $data;
289              
290 0         0 return;
291             }
292              
293             #####################################################################
294             sub _print_stats {
295 0     0   0 my($self) = @_;
296 0         0 my $out = $self->{'out'};
297 0         0 info('written:');
298 0         0 for my $type (qw/host hostgroup hostdependency hostextinfo hostescalation
299             service servicegroup servicedependency serviceextinfo serviceescalation
300             contact contactgroup command timeperiod
301             /) {
302 0         0 my $num = $self->_grep_count($out, '^\s*define\s*'.$type.'\( \|{\)');
303 0 0       0 next if $num == 0;
304 0         0 info(sprintf('# %-15s %6s', $type, $num));
305             }
306 0         0 return;
307             }
308              
309             #####################################################################
310             sub _grep_count {
311 0     0   0 my($self, $dir, $pattern) = @_;
312 0         0 my $txt = `grep -r -c '$pattern' $dir 2>&1`;
313 0         0 my $total = 0;
314 0         0 for my $line (split/\n/mx, $txt) {
315 0 0       0 if($line =~ m/:(\d+)$/mx) {
316 0         0 $total += $1;
317             }
318             }
319 0         0 return $total;
320             }
321              
322             #####################################################################
323             sub _build_template {
324 0     0   0 my($self, $dir, $type, $appdirs) = @_;
325 0         0 my $shorttype = substr($type, 0, -1);
326 0         0 my $template = "[% FOREACH d = data %][% ".$shorttype." = d %]\n";
327 0         0 my $found = 0;
328 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
329 0         0 for my $path (glob($in.'/'.$dir.'/'.$type.'/ '.
330             $in.'/'.$dir.'/'.$type.'*.cfg')
331             ) {
332 0         0 trace('looking for '.$type.' templates in '.$path);
333 0 0       0 if(-e $path) {
334 0         0 my $templates = $self->_get_files($path, '\.cfg');
335 0         0 for my $t (reverse sort @{$templates}) {
  0         0  
336 0 0 0     0 next if defined $self->{'opt'}->{'templatefilter'} and $t !~ m|$self->{'opt'}->{'templatefilter'}|mx;
337 0         0 my $tags = $self->_get_tags_for_path($t, $path);
338 0         0 my $required_type = shift @{$tags};
  0         0  
339 0 0       0 info('adding '.$type.' template: '.$t.($required_type ? ' for type '.$required_type : '').(scalar @{$tags} > 0 ? ' with tags: '.join(' & ', @{$tags}) : ''));
  0 0       0  
  0         0  
340 0 0       0 if($required_type) {
341 0         0 $self->{$type.'possible_types'}->{$required_type} = 1;
342 0         0 $template .= "[% IF d.type == '$required_type' %]";
343             }
344 0         0 for my $tag (@{$tags}) {
  0         0  
345 0         0 $self->{$type.'possible_tags'}->{$tag} = 1;
346 0         0 $template .= "[% IF d.has_tag('$tag') %]";
347             }
348 0         0 $template .= $self->_read_replaced_template($t);
349 0         0 for my $tag (@{$tags}) {
  0         0  
350 0         0 $template .= "[% END %]";
351             }
352 0 0       0 $template .= "[% END %]" if $required_type;
353 0         0 $found++;
354 0         0 $template .= "\n";
355             }
356             }
357             }
358             }
359              
360             # add apps for hosts
361 0 0 0     0 if(defined $appdirs and scalar @{$appdirs} > 0) {
  0         0  
362 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
363 0         0 for my $path (@{$appdirs}) {
  0         0  
364 0         0 $path = $in.'/'.$path;
365 0         0 trace('looking for '.$type.' apps in '.$path);
366 0 0       0 if(-e $path) {
367 0         0 my $templates = $self->_get_files($path, '\.cfg');
368 0         0 for my $t (reverse sort @{$templates}) {
  0         0  
369 0 0 0     0 next if defined $self->{'opt'}->{'templatefilter'} and $t !~ m|$self->{'opt'}->{'templatefilter'}|mx;
370 0         0 my $apps = $self->_get_tags_for_path($t, $path);
371 0 0       0 info('adding apps template: '.$t.(scalar @{$apps} > 0 ? ' for apps: '.join(' & ', @{$apps}) : ''));
  0         0  
  0         0  
372 0         0 for my $app (@{$apps}) {
  0         0  
373 0         0 $self->{'possible_apps'}->{$app} = 1;
374 0         0 $template .= "[% IF d.has_app('$app') %]";
375             }
376 0         0 $template .= $self->_read_replaced_template($t);
377 0         0 for my $app (@{$apps}) {
  0         0  
378 0         0 $template .= "[% END %]";
379             }
380 0         0 $found++;
381 0         0 $template .= "\n";
382             }
383             }
384             }
385             }
386             }
387              
388 0 0       0 if($found == 0) {
389 0         0 debug('no templates for type '.$type.' found');
390 0         0 return '';
391             }
392 0         0 $template .= "[% END %]\n";
393 0         0 trace('created template:');
394 0         0 trace($template);
395 0         0 return $template;
396             }
397              
398             #####################################################################
399             sub _get_files {
400 0     0   0 my($self, $dir, $pattern) = @_;
401 0 0 0     0 if(!-d $dir and $dir =~ m/$pattern/mx) {
402 0         0 return([$dir]);
403             }
404 0         0 my @files;
405 0 0       0 return \@files unless -d $dir;
406 0 0       0 opendir(my $d, $dir) or die("cannot read directory $dir: $!");
407 0         0 while(my $file = readdir($d)) {
408 0 0       0 next if substr($file,0,1) eq '.';
409 0 0       0 if(-d $dir.'/'.$file.'/.') {
410 0         0 push @files, @{$self->_get_files($dir.'/'.$file, $pattern)};
  0         0  
411             } else {
412 0 0       0 next if $file !~ m/$pattern/mx;
413 0         0 push @files, $dir."/".$file;
414             }
415             }
416 0         0 return \@files;
417             }
418              
419             #####################################################################
420             sub _process_template {
421 0     0   0 my($self, $template, $data) = @_;
422              
423 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
424 0         0 debug('looking for a '.$in.'/config.cfg');
425 0 0       0 if(-e $in.'/config.cfg') {
426 0         0 debug('added config template '.$in.'/config.cfg');
427 0         0 $template = $self->_read_replaced_template($in.'/config.cfg')."\n".$template;
428             }
429             }
430              
431 0         0 trace('template:');
432 0         0 trace('==========================');
433 0         0 trace($template);
434 0         0 trace('==========================');
435              
436 0         0 my $output;
437 0 0       0 $self->tt->process(\$template, $data, \$output) or $self->_template_process_die($template, $data);
438              
439             # clean up result
440 0         0 $output =~ s/^\s*$//sgmx;
441 0         0 $output =~ s/^\n//gmx;
442              
443 0         0 return $output;
444             }
445              
446             #####################################################################
447             sub _get_input_classes {
448 1     1   6 my($self, $folders) = @_;
449 1         3 my $types = [];
450              
451 1         3 for my $dir (@{$folders}) {
  1         4  
452 0 0       0 next unless -d $dir.'/lib/.';
453 0         0 unshift @INC, "$dir/lib";
454 0         0 trace('added '.$dir.'/lib to @INC');
455             }
456              
457 1         6 trace('@INC:');
458 1         3 trace(\@INC);
459              
460 1         2 my $uniq_types = {};
461 1         3 my $uniq_libs = {};
462 1         5 for my $inc (@INC) {
463 12 100       36 next if defined $uniq_libs->{$inc};
464 10         52 $uniq_libs->{$inc} = 1;
465 10         584 my @files = glob($inc.'/Monitoring/TT/Input/*.pm');
466 10         429 for my $file (glob($inc.'/Monitoring/TT/Input/*.pm')) {
467 4         17 trace('found input class: '.$file);
468 4         58 $file =~ s|^$inc/Monitoring/TT/Input/||mx;
469 4         14 $file =~ s|\.pm$||mx;
470 4 100       16 push @{$types}, $file unless defined $uniq_types->{$types}->{$file};
  2         4  
471 4         16 $uniq_types->{$types}->{$file} = 1;
472             }
473             }
474 1         40 return $types;
475             }
476              
477             #####################################################################
478             sub _get_input_types {
479 0     0   0 my($self, $folders) = @_;
480 0         0 my $input_types = {};
481 0         0 my $input_classes = $self->_get_input_classes($folders);
482 0         0 for my $t (@{$input_classes}) {
  0         0  
483 0         0 debug('requesting input files from: '.$t);
484 0         0 my $objclass = 'Monitoring::TT::Input::'.$t;
485             ## no critic
486 0         0 eval "require $objclass;";
487             ## use critic
488 0 0       0 error($@) if $@;
489 0         0 my $obj = \&{$objclass."::new"};
  0         0  
490 0         0 my $it = &$obj($objclass, montt => $self);
491 0         0 my $types = $it->get_types($folders);
492 0         0 trace('input \''.$t.'\' supports: '.join(', ', @{$types}));
  0         0  
493 0         0 for my $type (@{$types}) {
  0         0  
494 0 0       0 $input_types->{$type} = [] unless defined $input_types->{$type};
495 0         0 push @{$input_types->{$type}}, $it;
  0         0  
496             }
497             }
498 0         0 return $input_types;
499             }
500              
501             #####################################################################
502             sub _run_hook {
503 0     0   0 my($self, $name, $args) = @_;
504 0 0       0 return if $self->{'opt'}->{'dryrun'};
505 0         0 for my $in (@{$self->{'in'}}) {
  0         0  
506 0         0 my $hook = $in.'/hooks/'.$name;
507 0         0 trace("hook: looking for ".$hook);
508 0 0       0 if(-x $hook) {
509 0         0 my $cmd = $hook;
510 0 0       0 $cmd = $cmd." ".$args if defined $args;
511 0         0 debug($cmd);
512 0         0 open(my $ph, '-|', $cmd);
513 0         0 while(my $line = <$ph>) {
514 0         0 log($line);
515             }
516 0         0 close($ph);
517 0         0 my $rc = $?>>8;
518 0         0 debug('hook returned: '.$rc);
519 0 0       0 if($rc) {
520 0         0 debug(' -> exiting');
521 0         0 exit $rc;
522             }
523             }
524             }
525 0         0 return;
526             }
527              
528             #####################################################################
529             sub _read_replaced_template {
530 3     3   5 my($self, $template) = @_;
531 3         9 $template =~ s|//|/|gmx;
532 3         6 my $text = '[%# SRC '.$template.':1 #%]';
533 3 50       138 open(my $fh, '<', $template) or die("cannot read: ".$template.': '.$!);
534 3         53 while(my $line = <$fh>) {
535             # remove utf8 file bom
536 25 100       92 if($. == 1) {
537 3         7 my $bom = pack("CCC", 0xef, 0xbb, 0xbf);
538 3 50       13 if(substr($line,0,3) eq $bom) {
539 0         0 $line = substr($line, 3);
540             }
541             }
542 25         33 $text .= $line;
543 25 100       95 if($line =~ m/^define\s+(\w+)/mxo) {
544 3 50 33     32 if($1 eq 'service' or $1 eq 'host' or $1 eq 'contact') {
      33        
545 3         18 $text .= " _SRC ".$template.':'.$.."\n";
546             } else {
547 0         0 $text .= "# SRC ".$template.':'.$.."\n";
548             }
549             }
550             }
551 3         31 close($fh);
552 3         16 return $text;
553             }
554              
555             #####################################################################
556             sub _get_tags_for_path {
557 0     0     my($self, $path, $basepath) = @_;
558 0           my $tmppath = lc $path;
559 0           $tmppath =~ s|^$basepath||mx;
560 0           $tmppath =~ s|\.cfg$||mx;
561 0           $tmppath =~ s|^/||mx;
562 0           my @tags = split(/\//mx, $tmppath);
563 0           return \@tags;
564             }
565              
566             #####################################################################
567             sub _template_process_die {
568 0     0     my($self, $template, $data) = @_;
569 0           my $tterror = "".$self->tt->error();
570 0           my $already_printed = 0;
571              
572             # try to find file / line
573 0 0         if($tterror =~ m/input\s+text\s+line\s+(\d+)/mx) {
574 0           my $linenr = $1;
575 0           my @lines = split/\n/mx, $template;
576 0           my($realfile, $realline) = $self->_get_file_and_line_for_error(\@lines, $linenr);
577 0 0         if($realfile) {
578 0           my $newloc = $realfile.' line '.$realline;
579 0           $tterror =~ s|input\s+text\s+line\s+\d+|$newloc|gmx;
580             }
581             }
582              
583             # var.undef error - undefined variable: host.tag('contact_groups')
584 0 0         if($tterror =~ m/var\.undef\ error\ -\ undefined\ variable:\s+(.*)$/mx) {
585 0           my $err = $1;
586 0           my $linenr = 0;
587 0           error($tterror);
588 0           $already_printed = 1;
589 0           my @lines = split/\n/mx, $template;
590 0           for my $line (@lines) {
591 0           $linenr++;
592 0 0         if($line =~ m/\Q$err\E/mx) {
593 0           my($realfile, $realline) = $self->_get_file_and_line_for_error(\@lines, $linenr);
594 0 0         if($realfile) {
595 0           error('occurs in: '.$realfile.':'.$realline);
596             }
597             }
598             }
599             }
600              
601 0 0         error($tterror) unless $already_printed;
602 0           debug('in template:');
603 0           debug($template);
604 0           trace($data);
605 0           exit 1;
606             }
607              
608             #####################################################################
609             sub _get_file_and_line_for_error {
610 0     0     my($self, $lines, $linenr) = @_;
611 0           for(my $x = $linenr; $x >= 0; $x--) {
612 0 0 0       if(defined $lines->[$x] and $lines->[$x] =~ m/SRC\s+(.*):(\d+)/mx) {
613 0           my $diff = $x - $2 + 1;
614 0           return($1, ($linenr - $diff))
615             }
616             }
617 0           return(undef, undef);
618             }
619              
620             #####################################################################
621             sub _mkdir_r {
622 0     0     my($self, $dir) = @_;
623 0           my $path = '';
624 0           for my $part (split/(\/)/mx, $dir) {
625 0           $path .= $part;
626 0 0         next if $path eq '';
627 0 0         mkdir($path) unless -d $path;
628             }
629 0           return;
630             }
631              
632             #####################################################################
633             sub _check_typos {
634 0     0     my($self) = @_;
635 0           for my $type (qw/hosts contacts/) {
636 0           for my $o (@{$self->{'data'}->{$type}}) {
  0            
637 0 0         if($o->{'type'}) {
638 0 0         warn('unused type \''.$o->{'type'}.'\' defined in '.$o->{'file'}.':'.$o->{'line'}) unless defined $self->{$type.'possible_types'}->{$o->{'type'}};
639             }
640 0 0         if($o->{'tags'}) {
641 0           for my $t (keys %{$o->{'tags'}}) {
  0            
642 0 0         next if substr($t,0,1) eq '_';
643 0 0         warn('unused tag \''.$t.'\' defined in '.$o->{'file'}.':'.$o->{'line'}) unless defined $self->{$type.'possible_tags'}->{$t};
644             }
645             }
646 0 0         if($o->{'apps'}) {
647 0           for my $a (keys %{$o->{'apps'}}) {
  0            
648 0 0         warn('unused app \''.$a.'\' defined in '.$o->{'file'}.':'.$o->{'line'}) unless defined $self->{$type.'possible_apps'}->{$a};
649             }
650             }
651             }
652             }
653 0           return;
654             }
655              
656             =head1 AUTHOR
657              
658             Sven Nierlein, 2013,
659              
660             =cut
661              
662             1;