File Coverage

blib/lib/Monitoring/TT/Object.pm
Criterion Covered Total %
statement 18 78 23.0
branch 0 40 0.0
condition 0 6 0.0
subroutine 6 14 42.8
pod 6 6 100.0
total 30 144 20.8


line stmt bran cond sub pod time code
1             package Monitoring::TT::Object;
2              
3 4     4   26 use strict;
  4         6  
  4         111  
4 4     4   16 use warnings;
  4         8  
  4         122  
5 4     4   22 use utf8;
  4         9  
  4         23  
6 4     4   75 use Carp;
  4         7  
  4         218  
7 4     4   1420 use Monitoring::TT::Object::Contact;
  4         9  
  4         90  
8 4     4   1405 use Monitoring::TT::Object::Host;
  4         8  
  4         2872  
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 0         $current_object->{'montt'}->{$type.'spossible_tags'} = {} unless defined $current_object->{'montt'}->{$type.'spossible_tags'};
40 0           $current_object->{'possibletags'} = $current_object->{'montt'}->{$type.'spossible_tags'};
41 0           return $current_object;
42             }
43              
44             #####################################################################
45              
46             =head1 METHODS
47              
48             =head2 has_tag
49              
50             returns true if object has specific tag, false otherwise.
51              
52             =cut
53             sub has_tag {
54 0     0 1   my( $self, $tag, $val ) = @_;
55 0           $tag = lc($tag);
56 0           $self->{'possibletags'}->{$tag} = 1;
57 0   0       return &_has_something($self, 'conf', $tag, $val) || &_has_something($self, 'extra_tags', $tag, $val) || &_has_something($self, 'tags', $tag, $val);
58             }
59              
60             #####################################################################
61              
62             =head2 tags
63              
64             returns list of tags or empty list otherwise
65              
66             =cut
67             sub tags {
68 0     0 1   my( $self ) = @_;
69 0 0         return $self->{'tags'} if exists $self->{'tags'};
70 0           return [];
71             }
72              
73             #####################################################################
74              
75             =head2 extra_tags
76              
77             returns list of extra tags or empty list otherwise
78              
79             =cut
80             sub extra_tags {
81 0     0 1   my( $self ) = @_;
82 0 0         return $self->{'extra_tags'} if exists $self->{'extra_tags'};
83 0           return [];
84             }
85              
86             #####################################################################
87              
88             =head2 tag
89              
90             returns value of this tag or empty string if not set
91              
92             =cut
93             sub tag {
94 0     0 1   my( $self, $tag, $val ) = @_;
95 0 0         croak('tag() does not accept value, use has_tag() instead') if $val;
96 0           $tag = lc $tag;
97 0           $self->{'montt'}->{$self->{'object_type'}.'spossible_tags'}->{$tag} = 1;
98 0 0 0       if($self->{'extra_tags'}->{$tag} and $self->{'tags'}->{$tag}) {
99 0           my @list = @{$self->{'extra_tags'}->{$tag}};
  0            
100 0 0         push @list, ref $self->{'tags'}->{$tag} eq 'ARRAY' ? @{$self->{'tags'}->{$tag}} : $self->{'tags'}->{$tag};
  0            
101 0           return(Monitoring::TT::Utils::get_uniq_sorted(\@list));
102             }
103 0 0         return $self->{'extra_tags'}->{$tag} if $self->{'extra_tags'}->{$tag};
104 0 0         return $self->{'tags'}->{$tag} if $self->{'tags'}->{$tag};
105 0 0         return $self->{'conf'}->{$tag} if $self->{'conf'}->{$tag};
106 0           return "";
107             }
108              
109             #####################################################################
110              
111             =head2 set_tag
112              
113             set additional tag
114              
115             =cut
116             sub set_tag {
117 0     0 1   my( $self, $tag, $val ) = @_;
118 0           return $self->_set_something('extra_tags', $tag, $val);
119             }
120              
121             #####################################################################
122             # INTERNAL SUBS
123             #####################################################################
124             sub _has_something {
125 0     0     my( $self, $type, $tag, $val ) = @_;
126 0 0         return 0 unless exists $self->{$type};
127 0           $tag = lc $tag;
128 0 0         return 0 unless exists $self->{$type}->{$tag};
129 0 0         if(defined $val) {
130 0           $val = lc $val;
131 0           my $tags = $self->{$type}->{$tag};
132 0 0         if(ref $tags eq 'ARRAY') {
133 0           for my $a (@{$tags}) {
  0            
134 0 0         return 1 if lc($a) eq $val;
135             }
136             } else {
137 0 0         return 1 if lc($tags) eq $val;
138             }
139             } else {
140 0 0         return 1 if exists $self->{$type}->{$tag};
141             }
142 0           return 0;
143             }
144              
145             #####################################################################
146             sub _set_something {
147 0     0     my( $self, $type, $tag, $val ) = @_;
148 0           $tag = lc $tag;
149 0 0         $val = "" unless defined $val;
150 0 0         $self->{$type}->{$tag} = [] unless defined $self->{$type}->{$tag};
151 0 0         if(ref $self->{$type}->{$tag} ne 'ARRAY') {
152 0           $self->{$type}->{$tag} = Monitoring::TT::Utils::get_uniq_sorted([$self->{$type}->{$tag}, $val]);
153             } else {
154 0           $self->{$type}->{$tag} = Monitoring::TT::Utils::get_uniq_sorted([@{$self->{$type}->{$tag}}, $val]);
  0            
155             }
156 0           return "";
157             }
158              
159             #####################################################################
160              
161             =head1 AUTHOR
162              
163             Sven Nierlein, 2013,
164              
165             =cut
166              
167             1;