File Coverage

blib/lib/Flexnet/lmutil.pm
Criterion Covered Total %
statement 78 99 78.7
branch 29 54 53.7
condition 2 5 40.0
subroutine 6 7 85.7
pod 3 3 100.0
total 118 168 70.2


line stmt bran cond sub pod time code
1             package Flexnet::lmutil;
2              
3 2     2   36106 use 5.006;
  2         7  
4 2     2   10 use strict;
  2         3  
  2         45  
5 2     2   9 use warnings;
  2         11  
  2         71  
6 2     2   1041 use File::Which;
  2         1847  
  2         2789  
7              
8             =head1 NAME
9              
10             Flexnet::lmutil - Convenient OO-interface for Flexnet license server utility lmutil
11              
12             =head1 VERSION
13              
14             Version 1.5
15              
16             =cut
17              
18             our $VERSION = '1.5';
19              
20             =head1 DESCRIPTION
21              
22             Flexnet::lmutil is a small wrapper around the Flexnet license server utility lmutil,
23             currently implementing the sub-functions lmstat and lmremove. The module parses the
24             output of lmstat and returns an easy-to-use data structure. This makes it easy to
25             work further with lmstat output for e.g. web pages, monitoring plugins etc.
26              
27              
28             =head1 SYNOPSIS
29              
30             use Flexnet::lmutil;
31              
32             my $lmutil = new Flexnet::lmutil (
33             lm_license_path => 'port@host',
34             ...
35            
36             );
37              
38             $status = $lmutil->lmstat (
39             feature => 'feature',
40            
41             OR
42            
43             daemon => 'daemon',
44            
45             OR
46            
47             'all'
48             );
49              
50             $lmutil->lmremove (
51             feature => 'feature',
52             serverhost => 'host',
53             port => 'port',
54             handle => 'handle'
55             );
56              
57             =head1 DETAILS
58              
59             =over 1
60              
61             =item new
62              
63             Possible arguments for the constructor are:
64              
65             =over 4
66              
67             =item C
68              
69             either the full pathname of the license file or the string C
70             or even C...
71              
72             =item C
73              
74             show command line call
75              
76             =item C
77              
78             textfile containing lmstat output (for testing), does not run lmstat
79              
80             =back
81              
82             =item lmstat
83              
84             Possible arguments for C are:
85              
86             =over 4
87              
88             =item C
89              
90             get info about feature usage
91              
92             =item C
93              
94             get info about daemon usage
95              
96             =item C
97              
98             get info about usage of all daemons and features
99              
100             =back
101              
102             C returns a hash reference with the following keys:
103              
104             =over 4
105              
106             =item * C
107              
108             =item * C
109              
110             =item * C
111              
112             =back
113              
114             B points to another structure like
115              
116             'server' => {
117             'elba.uni-paderborn.de' => {
118             'ok' => 1,
119             'status' => 'UP'
120             }
121             },
122              
123             B points to a structure like
124              
125             'vendor' => {
126             'cdslmd' => {
127             'ok' => 1,
128             'status' => 'UP v11.11',
129             'version' => '11.11'
130             }
131             }
132              
133             B points to a structure like
134              
135             'feature' => {
136             'MATLAB' => {
137             'reservations' => [
138             {
139             'reservations' => '1',
140             'group' => 'etechnik-labor',
141             'type' => 'HOST_GROUP'
142             }
143             ],
144             'issued' => '115',
145             'used' => '36',
146             'users' => [
147             {
148             'serverhost' => 'dabu.uni-paderborn.de',
149             'startdate' => 'Wed 8/12 17:18',
150             'port' => '27000',
151             'licenses' => 1,
152             'display' => 'bessel',
153             'host' => 'bessel',
154             'handle' => '4401',
155             'user' => 'hangmann'
156             },
157             ]
158             },
159             },
160             ...
161              
162             =item lmremove
163              
164             The C method expects the following arguments as a hash:
165              
166             feature => 'feature',
167             serverhost => 'host',
168             port => 'port',
169             handle => 'handle'
170              
171             =back
172              
173             =head1 AUTHOR
174              
175             Christopher Odenbach, C<< >>
176              
177             =head1 BUGS
178              
179             Please report any bugs or feature requests to C, or through
180             the web interface at L. I will be notified, and then you'll
181             automatically be notified of progress on your bug as I make changes.
182              
183              
184              
185              
186             =head1 SUPPORT
187              
188             You can find documentation for this module with the perldoc command.
189              
190             perldoc Flexnet::lmutil
191              
192              
193             You can also look for information at:
194              
195             =over 4
196              
197             =item * RT: CPAN's request tracker (report bugs here)
198              
199             L
200              
201             =item * AnnoCPAN: Annotated CPAN documentation
202              
203             L
204              
205             =item * CPAN Ratings
206              
207             L
208              
209             =item * Search CPAN
210              
211             L
212              
213             =back
214              
215              
216             =head1 ACKNOWLEDGEMENTS
217              
218              
219             =head1 LICENSE AND COPYRIGHT
220              
221             Copyright 2015 Christopher Odenbach.
222              
223             This program is free software; you can redistribute it and/or modify it
224             under the terms of either: the GNU General Public License as published
225             by the Free Software Foundation; or the Artistic License.
226              
227             See http://dev.perl.org/licenses/ for more information.
228              
229              
230             =cut
231              
232             sub new {
233 1     1 1 16 my $pkg = shift;
234 1         5 my %args = @_;
235              
236 1   50     11 my $lmutil = ($args{lmutil} or which ('lmutil') or '');
237              
238 1 0 33     445 if (not defined $args{testfile} and not -x $lmutil ) {
239 0         0 die "lmutil not executable\n";
240             }
241              
242 1         6 my $self = {
243             lmutil => $lmutil,
244             %args
245             };
246 1         44 return bless ($self, $pkg);
247             }
248              
249             sub lmstat {
250 1     1 1 8 my $self = shift;
251            
252 1         5 my @args = @_;
253            
254 1 50       5 if (@args == 1) {
255 1         2 push @args, 1;
256             }
257 1         6 my %args = @args;
258              
259 1         2 my ($feature, $status);
260              
261 1         8 my $cmd = "$self->{lmutil} lmstat";
262              
263 1 50       6 if ( defined ($self->{lm_license_path})) {
264 0         0 $cmd .= " -c $self->{lm_license_path}";
265             }
266              
267 1 50       6 if ( defined ($args{all}) ) {
    0          
    0          
268 1         4 $cmd .= " -a";
269             } elsif ( defined ($args{feature}) ) {
270 0         0 $cmd .= " -f $args{feature}";
271             } elsif ( defined ($args{daemon}) ) {
272 0         0 $cmd .= " -S $args{daemon}";
273             }
274            
275             # for testing purpose we can provide a text file with the output of lmstat
276 1         2 my $fh;
277 1 50       4 if ( defined ($self->{testfile}) ) {
278 1 50       55 open ($fh, $self->{testfile}) or die "Could not open $self->{testfile}: $!";
279             } else {
280 0 0       0 print "Running command: $cmd\n" if $self->{verbose};
281 0         0 open ($fh, "$cmd |");
282             }
283            
284 1         37 while (<$fh>) {
285 98 50       211 print "lmstat: $_" if $self->{verbose};
286            
287             # lmgrd status
288 98 100       1025 if ( my ($server, $server_status) = /^\s*([\w.-]+): license server (\S+)/ ) {
    100          
    100          
    100          
    100          
289 1         5 $status->{server}->{$server}->{status} = $server_status;
290 1 50       6 if ( $server_status eq "UP" ) {
291 1         13 $status->{server}->{$server}->{ok} = 1;
292             } else {
293 0         0 $status->{server}->{$server}->{ok} = 0;
294             }
295            
296             # vendor daemon status
297             } elsif ( my ($vendor, $state) = /^\s*(\S+?): (.*)/ ) {
298              
299             # skip vendor_string line
300 3 50       13 next if $vendor eq 'vendor_string';
301              
302 3         11 $status->{vendor}->{$vendor}->{status} = $state;
303 3 50       15 if ( $state =~ /^UP v([\d.]+)/ ) {
304 3         6 $status->{vendor}->{$vendor}->{ok} = 1;
305 3         38 $status->{vendor}->{$vendor}->{version} = $1;
306             } else {
307 0         0 $status->{vendor}->{$vendor}->{ok} = 0;
308             }
309            
310             # feature usage info
311             } elsif ( /^Users of (\S+):\s*\(Total of (\d+) licenses? issued;\s*Total of (\d+) lic/ ) {
312 11         32 $feature = $1;
313 11         18 my $issued = $2;
314 11         13 my $used = $3;
315 11         44 $status->{feature}->{$feature}->{issued} = $issued;
316 11         61 $status->{feature}->{$feature}->{used} = $used;
317            
318             # user info
319             } elsif ( my ($clientinfo, $version, $serverhost, $port, $handle, $rest) =
320             m{^\s+(.+) \(v([\d\.]+)\) \(([^/]+)/(\d+) (\d+)\), start (.*)} ) {
321            
322 36         42 my ($user, $host);
323 36         39 my $display = '';
324            
325             # split clientinfo
326            
327 36         91 my @parts = split / /, $clientinfo;
328 36 100       81 if (@parts == 2) {
    100          
329 4         7 ($user, $host) = @parts;
330             } elsif (@parts == 3) {
331 28         45 ($user, $host, $display) = @parts;
332             } else {
333 4         5 my $max = @parts;
334            
335             # host = display?
336 4 100       15 if ($parts[$max - 2] eq $parts[$max - 1]) {
337 1         6 $display = pop @parts;
338 1         2 $host = pop @parts;
339 1         2 $user = join (' ', @parts);
340             } else {
341             # display contains / or : ?
342 3         4 my $i = 2;
343 3         8 while ($i <= @parts) {
344 3 50       16 if ($parts[$i] =~ m{^[:/]}) {
345 3         6 $display = $parts[$i];
346 3         5 $host = $parts[$i - 1];
347 3         9 $user = join (' ', map { $parts[$_] } 0..$i-2);
  3         13  
348 3         6 last;
349             }
350 0         0 $i++;
351             }
352            
353             # if still no luck, just guess
354 3 50       10 unless (defined $user) {
355 0         0 ($user, $host, $display) = @parts;
356             }
357             }
358             }
359            
360             # starttime and optional number of licenses
361 36         40 my $startdate;
362 36         35 my $licenses = 1;
363 36 100       76 if ($rest =~ /^([^,]+), (\d+) license/) {
364 1         4 $startdate = $1;
365 1         3 $licenses = $2;
366             } else {
367 35         37 $startdate = $rest;
368             }
369            
370 36         50 push @{$status->{feature}->{$feature}->{users}}, {
  36         430  
371             user=>$user,
372             host=>$host,
373             display=>$display,
374             licenses=>$licenses,
375             serverhost=>$serverhost,
376             port=>$port,
377             handle=>$handle,
378             startdate=>$startdate
379             };
380            
381             # reservation info
382             } elsif ( my ($reservations, $type, $group) = /^\s+(\d+)\s+RESERVATIONs? for ([\w_]+) ([\w_-]+) / ) {
383 4         6 push @{$status->{feature}->{$feature}->{reservations}},
  4         66  
384             {type=>$type, group=>$group, reservations=>$reservations};
385             }
386            
387             }
388 1         12 close ($fh);
389            
390 1         9 return $status;
391             }
392              
393             sub lmremove {
394 0     0 1   my $self = shift;
395 0           my %args = @_;
396 0           my $cmd;
397            
398 0           foreach my $arg (qw (feature serverhost port handle)) {
399 0 0         die "Parameter '$arg' missing\n" unless $args{$arg};
400             }
401            
402 0           $cmd = "$self->{lmutil} lmremove";
403 0 0         if ( defined ($self->{lm_license_path})) {
404 0           $cmd .= " -c $self->{lm_license_path}";
405             }
406 0           $cmd .= " -h $args{feature} $args{serverhost} $args{port} $args{handle}";
407              
408 0 0         print "Running command: $cmd\n" if $self->{verbose};
409 0           system($cmd);
410             }
411              
412              
413              
414              
415             1; # End of Flexnet::lmutil