File Coverage

blib/lib/Monitoring/TT/Object.pm
Criterion Covered Total %
statement 18 71 25.3
branch 0 34 0.0
condition 0 9 0.0
subroutine 6 14 42.8
pod 6 6 100.0
total 30 134 22.3


line stmt bran cond sub pod time code
1             package Monitoring::TT::Object;
2              
3 4     4   100 use strict;
  4         8  
  4         141  
4 4     4   19 use warnings;
  4         5  
  4         108  
5 4     4   19 use utf8;
  4         4  
  4         36  
6 4     4   74 use Carp;
  4         6  
  4         230  
7 4     4   3508 use Monitoring::TT::Object::Contact;
  4         9  
  4         95  
8 4     4   2011 use Monitoring::TT::Object::Host;
  4         12  
  4         3118  
9              
10             #####################################################################
11              
12             =head1 NAME
13              
14             Monitoring::TT::Object - Object representation of a data item
15              
16             =head1 DESCRIPTION
17              
18             contains generic methods which can be used in templates for each object
19              
20             =cut
21              
22             #####################################################################
23              
24             =head1 CONSTRUCTOR
25              
26             =head2 new
27              
28             returns new object
29              
30             =cut
31             sub new {
32 0     0 1   my( $class, $type, $data ) = @_;
33 0           $type = substr($type, 0, -1);
34 0           my $objclass = 'Monitoring::TT::Object::'.ucfirst($type);
35 0           my $obj = \&{$objclass."::BUILD"};
  0            
36 0 0         die("no such type: $type") unless defined &$obj;
37 0           $data->{'object_type'} = lc($type);
38 0           my $current_object = &$obj($objclass, $data);
39 0           return $current_object;
40             }
41              
42             #####################################################################
43              
44             =head1 METHODS
45              
46             =head2 has_tag
47              
48             returns true if object has specific tag, false otherwise.
49              
50             =cut
51             sub has_tag {
52 0     0 1   my( $self, $tag, $val ) = @_;
53 0   0       return $self->_has_something('conf', $tag, $val) || $self->_has_something('extra_tags', $tag, $val) || $self->_has_something('tags', $tag, $val);
54             }
55              
56             #####################################################################
57              
58             =head2 tags
59              
60             returns list of tags or empty list otherwise
61              
62             =cut
63             sub tags {
64 0     0 1   my( $self ) = @_;
65 0 0         return $self->{'tags'} if exists $self->{'tags'};
66 0           return [];
67             }
68              
69             #####################################################################
70              
71             =head2 extra_tags
72              
73             returns list of extra tags or empty list otherwise
74              
75             =cut
76             sub extra_tags {
77 0     0 1   my( $self ) = @_;
78 0 0         return $self->{'extra_tags'} if exists $self->{'extra_tags'};
79 0           return [];
80             }
81              
82             #####################################################################
83              
84             =head2 tag
85              
86             returns value of this tag or empty string if not set
87              
88             =cut
89             sub tag {
90 0     0 1   my( $self, $tag, $val ) = @_;
91 0 0         croak('tag() does not accept value, use has_tag() instead') if $val;
92 0           $tag = lc $tag;
93 0           $self->{'montt'}->{$self->{'object_type'}.'spossible_tags'}->{$tag} = 1;
94 0 0 0       if($self->{'extra_tags'}->{$tag} and $self->{'tags'}->{$tag}) {
95 0           my @list = @{$self->{'extra_tags'}->{$tag}};
  0            
96 0 0         push @list, ref $self->{'tags'}->{$tag} eq 'ARRAY' ? @{$self->{'tags'}->{$tag}} : $self->{'tags'}->{$tag};
  0            
97 0           return(Monitoring::TT::Utils::get_uniq_sorted(\@list));
98             }
99 0 0         return $self->{'extra_tags'}->{$tag} if $self->{'extra_tags'}->{$tag};
100 0 0         return $self->{'tags'}->{$tag} if $self->{'tags'}->{$tag};
101 0 0         return $self->{'conf'}->{$tag} if $self->{'conf'}->{$tag};
102 0           return "";
103             }
104              
105             #####################################################################
106              
107             =head2 set_tag
108              
109             set additional tag
110              
111             =cut
112             sub set_tag {
113 0     0 1   my( $self, $tag, $val ) = @_;
114 0           return $self->_set_something('extra_tags', $tag, $val);
115             }
116              
117             #####################################################################
118             # INTERNAL SUBS
119             #####################################################################
120             sub _has_something {
121 0     0     my( $self, $type, $tag, $val ) = @_;
122 0           $tag = lc $tag;
123 0           $self->{'montt'}->{$self->{'object_type'}.'spossible_'.$type}->{$tag} = 1;
124 0 0         if(defined $val) {
125 0 0         if(ref $self->{$type}->{$tag} eq 'ARRAY') {
126 0           for my $a (@{$self->{$type}->{$tag}}) {
  0            
127 0 0         return 1 if lc($a) eq lc($val);
128             }
129             } else {
130 0 0 0       return 1 if defined $self->{$type}->{$tag} and lc($self->{$type}->{$tag}) eq lc($val);
131             }
132             } else {
133 0 0         return 1 if exists $self->{$type}->{$tag};
134             }
135 0           return 0;
136             }
137              
138             #####################################################################
139             sub _set_something {
140 0     0     my( $self, $type, $tag, $val ) = @_;
141 0           $tag = lc $tag;
142 0 0         $val = "" unless defined $val;
143 0 0         $self->{$type}->{$tag} = [] unless defined $self->{$type}->{$tag};
144 0 0         if(ref $self->{$type}->{$tag} ne 'ARRAY') {
145 0           $self->{$type}->{$tag} = Monitoring::TT::Utils::get_uniq_sorted([$self->{$type}->{$tag}, $val]);
146             } else {
147 0           $self->{$type}->{$tag} = Monitoring::TT::Utils::get_uniq_sorted([@{$self->{$type}->{$tag}}, $val]);
  0            
148             }
149 0           return "";
150             }
151              
152             #####################################################################
153              
154             =head1 AUTHOR
155              
156             Sven Nierlein, 2013,
157              
158             =cut
159              
160             1;