line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Hardware::UPS::Perl::Connection; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
#============================================================================== |
4
|
|
|
|
|
|
|
# package description: |
5
|
|
|
|
|
|
|
#============================================================================== |
6
|
|
|
|
|
|
|
# This package supplies a set of methods to load a connection. For a detailed |
7
|
|
|
|
|
|
|
# description see the pod documentation included at the end of this file. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# List of public methods: |
10
|
|
|
|
|
|
|
# ----------------------- |
11
|
|
|
|
|
|
|
# new - initializing a Hardware::UPS::Perl::Connection |
12
|
|
|
|
|
|
|
# object |
13
|
|
|
|
|
|
|
# setLogger - setting the current logger |
14
|
|
|
|
|
|
|
# getLogger - getting the current logger |
15
|
|
|
|
|
|
|
# setConnectionOptions - setting the connection options |
16
|
|
|
|
|
|
|
# getConnectionOptions - getting the connection options |
17
|
|
|
|
|
|
|
# setConnectionHandle - setting the connection handle |
18
|
|
|
|
|
|
|
# getConnectionHandle - getting the current connection handle |
19
|
|
|
|
|
|
|
# getErrorMessage - getting internal error messages |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
#============================================================================== |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
#============================================================================== |
24
|
|
|
|
|
|
|
# Copyright: |
25
|
|
|
|
|
|
|
#============================================================================== |
26
|
|
|
|
|
|
|
# Copyright (c) 2007 Christian Reile, . All |
27
|
|
|
|
|
|
|
# rights reserved. This program is free software; you can redistribute it |
28
|
|
|
|
|
|
|
# and/or modify it under the same terms as Perl itself. |
29
|
|
|
|
|
|
|
#============================================================================== |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#============================================================================== |
32
|
|
|
|
|
|
|
# Entries for Revision Control: |
33
|
|
|
|
|
|
|
#============================================================================== |
34
|
|
|
|
|
|
|
# Revision : $Revision: 1.6 $ |
35
|
|
|
|
|
|
|
# Author : $Author: creile $ |
36
|
|
|
|
|
|
|
# Last Modified On: $Date: 2007/04/17 19:45:01 $ |
37
|
|
|
|
|
|
|
# Status : $State: Exp $ |
38
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
39
|
|
|
|
|
|
|
# Modifications : |
40
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
41
|
|
|
|
|
|
|
# |
42
|
|
|
|
|
|
|
# $Log: Connection.pm,v $ |
43
|
|
|
|
|
|
|
# Revision 1.6 2007/04/17 19:45:01 creile |
44
|
|
|
|
|
|
|
# missing import of Hardware::UPS::Perl::Logging added. |
45
|
|
|
|
|
|
|
# |
46
|
|
|
|
|
|
|
# Revision 1.5 2007/04/14 09:37:26 creile |
47
|
|
|
|
|
|
|
# documentation update. |
48
|
|
|
|
|
|
|
# |
49
|
|
|
|
|
|
|
# Revision 1.4 2007/04/07 15:13:24 creile |
50
|
|
|
|
|
|
|
# adaptations to "best practices" style; |
51
|
|
|
|
|
|
|
# update of documentation. |
52
|
|
|
|
|
|
|
# |
53
|
|
|
|
|
|
|
# Revision 1.3 2007/03/13 17:17:23 creile |
54
|
|
|
|
|
|
|
# options as anonymous hashes; |
55
|
|
|
|
|
|
|
# reconnect fix. |
56
|
|
|
|
|
|
|
# |
57
|
|
|
|
|
|
|
# Revision 1.2 2007/03/03 21:22:45 creile |
58
|
|
|
|
|
|
|
# new variable $UPSERROR added; |
59
|
|
|
|
|
|
|
# "return undef" replaced by "return"; |
60
|
|
|
|
|
|
|
# adaptations to new Constants.pm; |
61
|
|
|
|
|
|
|
# option "Connection" of method new() changed to "Type". |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
# Revision 1.1 2007/02/25 17:02:44 creile |
64
|
|
|
|
|
|
|
# initial revision. |
65
|
|
|
|
|
|
|
# |
66
|
|
|
|
|
|
|
# |
67
|
|
|
|
|
|
|
#============================================================================== |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
#============================================================================== |
70
|
|
|
|
|
|
|
# module preamble: |
71
|
|
|
|
|
|
|
#============================================================================== |
72
|
|
|
|
|
|
|
|
73
|
1
|
|
|
1
|
|
23215
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
BEGIN { |
76
|
|
|
|
|
|
|
|
77
|
1
|
|
|
1
|
|
6
|
use vars qw($VERSION @ISA); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
93
|
|
78
|
|
|
|
|
|
|
|
79
|
1
|
|
|
1
|
|
8
|
$VERSION = sprintf( "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/ ); |
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
|
|
43
|
@ISA = qw(); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
#============================================================================== |
86
|
|
|
|
|
|
|
# end of module preamble |
87
|
|
|
|
|
|
|
#============================================================================== |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
#============================================================================== |
90
|
|
|
|
|
|
|
# packages required: |
91
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
92
|
|
|
|
|
|
|
# |
93
|
|
|
|
|
|
|
# Hardware::UPS::Perl::General - importing Hardware::UPS::Perl variables |
94
|
|
|
|
|
|
|
# and functions for scripts |
95
|
|
|
|
|
|
|
# Hardware::UPS::Perl::Logging - importing Hardware::UPS::Perl methods |
96
|
|
|
|
|
|
|
# dealing with logfiles |
97
|
|
|
|
|
|
|
# Hardware::UPS::Perl::Utils - importing Hardware::UPS::Perl utility |
98
|
|
|
|
|
|
|
# functions for packages |
99
|
|
|
|
|
|
|
# |
100
|
|
|
|
|
|
|
#============================================================================== |
101
|
|
|
|
|
|
|
|
102
|
1
|
|
|
|
|
131
|
use Hardware::UPS::Perl::General qw( |
103
|
|
|
|
|
|
|
$UPSERROR |
104
|
1
|
|
|
1
|
|
633
|
); |
|
1
|
|
|
|
|
4
|
|
105
|
1
|
|
|
1
|
|
7
|
use Hardware::UPS::Perl::Logging; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
106
|
1
|
|
|
|
|
1201
|
use Hardware::UPS::Perl::Utils qw( |
107
|
|
|
|
|
|
|
error |
108
|
1
|
|
|
1
|
|
4
|
); |
|
1
|
|
|
|
|
2
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
#============================================================================== |
111
|
|
|
|
|
|
|
# public methods: |
112
|
|
|
|
|
|
|
#============================================================================== |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub new { |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# public method to construct a connection object |
117
|
|
|
|
|
|
|
# |
118
|
|
|
|
|
|
|
# parameters: $class (input) - class |
119
|
|
|
|
|
|
|
# $options (input) - anonymous hash; options |
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
# The following option keys are recognized: |
122
|
|
|
|
|
|
|
# |
123
|
|
|
|
|
|
|
# Type ($) - string; the connection type to load; optional; |
124
|
|
|
|
|
|
|
# Options ($) - anonymous array; the options of the connection to |
125
|
|
|
|
|
|
|
# load; optional; |
126
|
|
|
|
|
|
|
# Logger ($) - Hardware::UPS::Perl::Logging object; the logger to |
127
|
|
|
|
|
|
|
# use; optional. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# input as hidden local variables |
130
|
1
|
|
|
1
|
1
|
485
|
my $class = shift; |
131
|
1
|
50
|
|
|
|
5
|
my $options = @_ ? shift : {}; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# hidden local variables |
134
|
1
|
|
|
|
|
3
|
my $self = {}; # referent to be blessed |
135
|
1
|
|
|
|
|
2
|
my $option; # an option |
136
|
|
|
|
|
|
|
my $refType; # a reference type |
137
|
0
|
|
|
|
|
0
|
my $logger; # the logger object |
138
|
0
|
|
|
|
|
0
|
my $connectionType; # the connection type |
139
|
0
|
|
|
|
|
0
|
my $connectionOptions; # the connection options |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# blessing connection object |
142
|
1
|
|
|
|
|
2
|
bless $self, $class; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# checking options |
145
|
1
|
|
|
|
|
4
|
$refType = ref($options); |
146
|
1
|
50
|
|
|
|
4
|
if ($refType ne 'HASH') { |
147
|
0
|
|
|
|
|
0
|
error("not a hash reference -- <$refType>"); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# the logger; if we don't have one, we have to create our own with output |
151
|
|
|
|
|
|
|
# on STDERR |
152
|
1
|
|
|
|
|
2
|
$logger = delete $options->{Logger}; |
153
|
|
|
|
|
|
|
|
154
|
1
|
50
|
|
|
|
5
|
unless (defined $logger) { |
155
|
0
|
0
|
|
|
|
0
|
$logger = Hardware::UPS::Perl::Logging->new() |
156
|
|
|
|
|
|
|
or return; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
1
|
|
|
|
|
5
|
$self->setLogger($logger); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# the connection options |
162
|
1
|
|
|
|
|
2
|
$connectionOptions = delete $options->{Options}; |
163
|
|
|
|
|
|
|
|
164
|
1
|
50
|
|
|
|
13
|
if (defined $connectionOptions) { |
165
|
0
|
|
|
|
|
0
|
$refType = ref($connectionOptions); |
166
|
0
|
0
|
|
|
|
0
|
if ($refType ne 'HASH') { |
167
|
0
|
|
|
|
|
0
|
error("no hash reference -- <$refType>"); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
else { |
171
|
1
|
|
|
|
|
2
|
$connectionOptions = {}; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# the connection type |
175
|
1
|
|
|
|
|
3
|
$connectionType = delete $options->{Type}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# checking for misspelled options |
178
|
1
|
|
|
|
|
2
|
foreach $option (keys %{$options}) { |
|
1
|
|
|
|
|
5
|
|
179
|
0
|
|
|
|
|
0
|
error("option unknown -- $option"); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# initializing the error message |
183
|
1
|
|
|
|
|
2
|
$self->{errorMessage} = q{}; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# setting the connection |
186
|
1
|
|
|
|
|
5
|
$self->setConnectionOptions($connectionOptions); |
187
|
|
|
|
|
|
|
|
188
|
1
|
50
|
|
|
|
3
|
if (defined $connectionType) { |
189
|
|
|
|
|
|
|
$self->setConnectionHandle($connectionType) |
190
|
0
|
0
|
|
|
|
0
|
or do { |
191
|
0
|
|
|
|
|
0
|
$UPSERROR = $self->getErrorMessage(); |
192
|
0
|
|
|
|
|
0
|
return; |
193
|
|
|
|
|
|
|
}; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# returning blessed connection object |
197
|
1
|
|
|
|
|
4
|
return $self; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
} # end of public method "new" |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
0
|
|
0
|
sub DESTROY { |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# the destructor will do nothing, actually |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
} # end of the destructor |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub getErrorMessage { |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# public method to get the current error message |
210
|
|
|
|
|
|
|
# |
211
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# input as hidden local variable |
214
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# getting the error message |
217
|
0
|
0
|
|
|
|
0
|
if (exists $self->{errorMessage}) { |
218
|
0
|
|
|
|
|
0
|
return $self->{errorMessage}; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
else { |
221
|
0
|
|
|
|
|
0
|
return; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
} # end of public method "getErrorMessage" |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub getLogger { |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# public method to get the logger |
229
|
|
|
|
|
|
|
# |
230
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# input as hidden local variable |
233
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# getting logger |
236
|
1
|
50
|
|
|
|
8
|
if (exists $self->{logger}) { |
237
|
0
|
|
|
|
|
0
|
return $self->{logger}; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
1
|
|
|
|
|
2
|
return; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
} # end of public method "getLogger" |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub setLogger { |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# public method to set the logger |
248
|
|
|
|
|
|
|
# |
249
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
250
|
|
|
|
|
|
|
# $logger (input) - the logging object |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# input as hidden local variables |
253
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
254
|
|
|
|
|
|
|
|
255
|
1
|
50
|
|
|
|
4
|
1 == @_ or error("usage: setLogger(LOGGER)"); |
256
|
1
|
|
|
|
|
2
|
my $logger = shift; |
257
|
|
|
|
|
|
|
|
258
|
1
|
50
|
|
|
|
4
|
if (defined $logger) { |
259
|
1
|
|
|
|
|
2
|
my $loggerRefType = ref($logger); |
260
|
1
|
50
|
|
|
|
5
|
if ($loggerRefType ne 'Hardware::UPS::Perl::Logging') { |
261
|
0
|
|
|
|
|
0
|
error("no logger -- <$loggerRefType>"); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# getting old logger |
266
|
1
|
|
|
|
|
4
|
my $oldLogger = $self->getLogger(); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# setting the logger |
269
|
1
|
|
|
|
|
5
|
$self->{logger} = $logger; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# returning old logger |
272
|
1
|
|
|
|
|
2
|
return $oldLogger; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
} # end of public method "setLogger" |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub getConnectionOptions { |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# public method to get the options of the connection |
279
|
|
|
|
|
|
|
# |
280
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# input as hidden local variable |
283
|
1
|
|
|
1
|
1
|
1
|
my $self = shift; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# getting connection options |
286
|
1
|
50
|
|
|
|
3
|
if (exists $self->{options}) { |
287
|
0
|
|
|
|
|
0
|
return $self->{options}; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
else { |
290
|
1
|
|
|
|
|
9
|
return; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
} # end of public method "getConnectionOptions" |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub setConnectionOptions { |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# public method to set the options for connection to load |
298
|
|
|
|
|
|
|
# |
299
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
300
|
|
|
|
|
|
|
# $options (input) - anonymous hash; the connection options |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# input as hidden local variables |
303
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
304
|
|
|
|
|
|
|
|
305
|
1
|
50
|
33
|
|
|
17
|
( (1 == @_) and (ref($_[0]) eq 'HASH')) |
306
|
|
|
|
|
|
|
or error("usage: setConnectionOptions(\%options)"); |
307
|
|
|
|
|
|
|
|
308
|
1
|
|
|
|
|
2
|
my $options = shift; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# getting old connection options |
311
|
1
|
|
|
|
|
4
|
my $oldConnectionOptions = $self->getConnectionOptions(); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# setting connection options |
314
|
1
|
|
|
|
|
4
|
$self->{options} = $options; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# returning old connection option |
317
|
1
|
|
|
|
|
2
|
return $oldConnectionOptions; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
} # end of public method "setConnectionOptions" |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub getConnectionHandle { |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# public method to get the connection handle |
324
|
|
|
|
|
|
|
# |
325
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# input as hidden local variable |
328
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# getting connection handle |
331
|
0
|
0
|
|
|
|
|
if (exists $self->{connection}) { |
332
|
0
|
|
|
|
|
|
return $self->{connection}; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
else { |
335
|
0
|
|
|
|
|
|
return; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
} # end of public method "getConnectionHandle" |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub setConnectionHandle { |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
# public method to load the connection handle |
343
|
|
|
|
|
|
|
# |
344
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
345
|
|
|
|
|
|
|
# $connection (input) - string; the name of the connection to |
346
|
|
|
|
|
|
|
# load |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# input as hidden local variables |
349
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
350
|
|
|
|
|
|
|
|
351
|
0
|
0
|
|
|
|
|
(1 == @_) or error("usage: setConnectionHandle(connection)"); |
352
|
0
|
|
|
|
|
|
my $connection = shift; |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# hidden local variables |
355
|
0
|
|
|
|
|
|
my $connectionClass; # the connection class |
356
|
|
|
|
|
|
|
my $connectionHandle; # the connection handle |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# getting connection class, making allowance for case-insensitivity |
359
|
0
|
|
|
|
|
|
$connectionClass = |
360
|
|
|
|
|
|
|
"Hardware::UPS::Perl::Connection::".ucfirst(lc($connection)); |
361
|
0
|
|
|
|
|
|
eval qq{ |
362
|
|
|
|
|
|
|
use $connectionClass; # load the connection |
363
|
|
|
|
|
|
|
}; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# checking eval error |
366
|
0
|
0
|
|
|
|
|
if ($@) { |
367
|
0
|
|
|
|
|
|
$self->{errorMessage} = "eval failed -- $@"; |
368
|
0
|
|
|
|
|
|
return 0; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# setting up connection object |
372
|
0
|
|
|
|
|
|
$connectionHandle = eval { |
373
|
0
|
|
|
|
|
|
$connectionClass->new($self->getConnectionOptions()) |
374
|
|
|
|
|
|
|
}; |
375
|
|
|
|
|
|
|
|
376
|
0
|
0
|
0
|
|
|
|
if (!$connectionHandle or !ref($connectionHandle) or $@) { |
|
|
|
0
|
|
|
|
|
377
|
0
|
|
|
|
|
|
$self->{errorMessage} = "$connectionClass initialisation failed -- $@"; |
378
|
0
|
|
|
|
|
|
return 0; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
$self->{connection} = $connectionHandle; |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
|
return 1; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
} # end of public method "setConnectionHandle" |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub connect { |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# public method to connect to an UPA agent or the serial port an UPS |
390
|
|
|
|
|
|
|
# resides |
391
|
|
|
|
|
|
|
# |
392
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# input as hidden local variable |
395
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# getting connection handle |
398
|
0
|
|
|
|
|
|
my $connectionHandle = $self->getConnectionHandle(); |
399
|
0
|
0
|
|
|
|
|
if (!$connectionHandle->connect(@_)) { |
400
|
0
|
|
|
|
|
|
$self->{errorMessage} |
401
|
|
|
|
|
|
|
= "connection failed -- ".$connectionHandle->getErrorMessage(); |
402
|
0
|
|
|
|
|
|
return 0; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
0
|
|
|
|
|
|
return 1; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
} # end of public method "connect" |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub connected { |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# public method to test the connection status |
412
|
|
|
|
|
|
|
# |
413
|
|
|
|
|
|
|
# parameters: $self (input) - referent to a connection object |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# input as hidden local variable |
416
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# hidden local variables |
419
|
0
|
|
|
|
|
|
my $connectionHandle; # the connection |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# checking for connection |
422
|
0
|
|
|
|
|
|
$connectionHandle = $self->getConnectionHandle(); |
423
|
0
|
0
|
|
|
|
|
if (defined $connectionHandle) { |
424
|
0
|
|
|
|
|
|
return $connectionHandle->connected(); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
else { |
427
|
0
|
|
|
|
|
|
return 0; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
} # end of public method "connected" |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
sub disconnect { |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
# public method to disconnect from an UPS agent or the serial |
435
|
|
|
|
|
|
|
# port a local UPS resides |
436
|
|
|
|
|
|
|
# |
437
|
|
|
|
|
|
|
# parameters: $self (input) - referent to an UPS object |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# input as hidden local variable |
440
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# deleting connection if connected |
443
|
0
|
0
|
|
|
|
|
if ($self->connected()) { |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# deleting connection |
446
|
0
|
|
|
|
|
|
$self->getConnectionHandle()->disconnect(); |
447
|
|
|
|
|
|
|
|
448
|
0
|
|
|
|
|
|
return 1; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
else { |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# error: UPS was not connected |
454
|
0
|
|
|
|
|
|
$self->{errorMessage} = "not connected to UPS"; |
455
|
|
|
|
|
|
|
|
456
|
0
|
|
|
|
|
|
return 0; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
} # end of public method "disconnect" |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
sub sendCommand { |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# public method to send a command to the UPS and getting its response |
464
|
|
|
|
|
|
|
# |
465
|
|
|
|
|
|
|
# parameters: $self (input) - referent to an UPS object |
466
|
|
|
|
|
|
|
# $command (input) - command sent to UPS |
467
|
|
|
|
|
|
|
# $response (input) - response from UPS (anonymous reference) |
468
|
|
|
|
|
|
|
# $responseSize (input) - size of response from UPS |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# input as hidden local variable |
471
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
472
|
0
|
|
|
|
|
|
my $command = shift; |
473
|
0
|
|
|
|
|
|
my $response = shift; |
474
|
0
|
|
|
|
|
|
my $responseSize = shift; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# hidden local variables |
477
|
0
|
|
|
|
|
|
my $connectionHandle; # the connection |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# getting connection |
480
|
0
|
|
|
|
|
|
$connectionHandle = $self->getConnectionHandle(); |
481
|
0
|
0
|
|
|
|
|
unless (defined $connectionHandle) { |
482
|
0
|
|
|
|
|
|
$self->{errorMessage} = "no connection handle available"; |
483
|
0
|
|
|
|
|
|
return 0; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# send message to UPS |
487
|
0
|
0
|
|
|
|
|
if ($connectionHandle->sendCommand($command, $response, $responseSize)) { |
488
|
0
|
|
|
|
|
|
return 1; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
else { |
491
|
0
|
|
|
|
|
|
$self->{errorMessage} = $connectionHandle->getErrorMessage(); |
492
|
0
|
|
|
|
|
|
return 0; |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
} # end of public method "sendCommand" |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
#============================================================================== |
498
|
|
|
|
|
|
|
# package return: |
499
|
|
|
|
|
|
|
#============================================================================== |
500
|
|
|
|
|
|
|
1; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
__END__ |