File Coverage

blib/lib/App/MonM/Const.pm
Criterion Covered Total %
statement 21 31 67.7
branch 1 6 16.6
condition 0 5 0.0
subroutine 7 11 63.6
pod n/a
total 29 53 54.7


line stmt bran cond sub pod time code
1             package App::MonM::Const; # $Id: Const.pm 125 2022-09-06 17:24:56Z abalama $
2 5     5   30 use strict;
  5         10  
  5         127  
3 5     5   33 use utf8;
  5         13  
  5         26  
4              
5             =encoding utf8
6              
7             =head1 NAME
8              
9             App::MonM::Const - Interface for App::MonM general constants
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             use App::MonM::Const;
18              
19             =head1 DESCRIPTION
20              
21             This module provide interface for App::MonM general constants
22              
23             =head2 SHARED CONSTANTS
24              
25             =over 4
26              
27             =item DAEMONMAME
28              
29             Daemon name
30              
31             =item GROUPNAME, USERNAME
32              
33             Daemon user and group name
34              
35             =item HOSTNAME
36              
37             Hostname
38              
39             =item PREFIX
40              
41             Prefix of project
42              
43             =item PROJECTNAME
44              
45             Project name
46              
47             =item PROJECTNAMEL
48              
49             Project name in lower case
50              
51             =item IS_TTY
52              
53             Returns boolean TTY status if current session runs under terminal
54              
55             =back
56              
57             =head2 NOT IMPORTED CONSTANTS
58              
59             =over 4
60              
61             =item TRUE, FALSE, VOID
62              
63             1, 0, '' values
64              
65             =item OK, DONE, ERROR, SKIPPED, PASSED, FAILED, UNKNOWN, PROBLEM
66              
67             Test result statuses
68              
69             =back
70              
71             =head1 HISTORY
72              
73             See C file
74              
75             =head1 TO DO
76              
77             See C file
78              
79             =head1 AUTHOR
80              
81             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
82              
83             =head1 COPYRIGHT
84              
85             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
86              
87             =head1 LICENSE
88              
89             This program is free software; you can redistribute it and/or
90             modify it under the same terms as Perl itself.
91              
92             See C file and L
93              
94             =cut
95              
96 5     5   185 use vars qw/$VERSION @EXPORT @EXPORT_OK/;
  5         10  
  5         269  
97             $VERSION = '1.01';
98              
99 5     5   1896 use Sys::Hostname qw/hostname/;
  5         5391  
  5         250  
100 5     5   2623 use Try::Tiny;
  5         8869  
  5         244  
101              
102 5     5   28 use base qw/Exporter/;
  5         13  
  5         678  
103              
104             use constant {
105 5 50       2038 PROJECTNAME => "MonM",
106             PROJECTNAMEL => "monm",
107             PREFIX => "monm",
108             DAEMONMAME => 'monmd',
109             USERNAME => 'monmu',
110             GROUPNAME => 'monmu',
111              
112             # TTY
113             IS_TTY => (-t STDOUT) ? 1 : 0,
114             SCREENWIDTH_DEFAULT => 80,
115              
116             # BOOLEAN
117             TRUE => 1,
118             FALSE => 0,
119             VOID => '',
120              
121             # Date & Time
122             DATETIME_FORMAT => "%w, %DD %MON %YYYY %hh:%mm:%ss",
123             DATETIME_GMT_FORMAT => "%w, %DD %MON %YYYY %hh:%mm:%ss %G",
124              
125             # Test results
126             OK => "OK", # for SMALL operations
127             DONE => "DONE", # for LONG operations
128             ERROR => "ERROR", # for operations
129             SKIPPED => "SKIPPED", # for tests
130             PASSED => "PASSED", # for tests
131             FAILED => "FAILED", # for tests
132             UNKNOWN => "UNKNOWN", # for tests
133             PROBLEM => "PROBLEM", # for tests
134 5     5   100 };
  5         15  
135              
136             @EXPORT = (qw/
137             PROJECTNAME PROJECTNAMEL PREFIX DAEMONMAME
138             USERNAME GROUPNAME
139             HOSTNAME
140             IS_TTY
141             SCREENWIDTH
142             DATETIME_FORMAT DATETIME_GMT_FORMAT
143             /);
144             @EXPORT_OK = (qw/
145             TRUE FALSE VOID
146             OK DONE ERROR SKIPPED PASSED FAILED UNKNOWN PROBLEM
147             /);
148              
149             my $myhostname = undef;
150             *HOSTNAME = sub {
151 0   0 0     $myhostname ||= (hostname() // 'localhost');
      0        
152 0           return $myhostname;
153             };
154              
155             my $myscreenw = undef;
156             *SCREENWIDTH = sub {
157 0 0   0     return $myscreenw if defined $myscreenw;
158 0           if (IS_TTY) {
159             try {
160 0     0     require Term::ReadKey;
161 0           my $w = (Term::ReadKey::GetTerminalSize())[0];
162 0 0         $myscreenw = $w < SCREENWIDTH_DEFAULT ? SCREENWIDTH_DEFAULT : $w;
163             } catch {
164 0     0     $myscreenw = SCREENWIDTH_DEFAULT;
165             };
166             } else {
167 0           $myscreenw = SCREENWIDTH_DEFAULT;
168             }
169 0           return $myscreenw;
170             };
171              
172             1;
173              
174             __END__