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 76 2019-07-07 05:20:28Z abalama $
2 2     2   11 use strict;
  2         4  
  2         49  
3 2     2   10 use utf8;
  2         2  
  2         8  
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.00
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 HOSTNAME
28              
29             Hostname
30              
31             =item PREFIX
32              
33             Prefix of project
34              
35             =item PROJECTNAME
36              
37             Project name
38              
39             =item PROJECTNAMEL
40              
41             Project name in lower case
42              
43             =item IS_TTY
44              
45             Returns boolean TTY status if current session runs under terminal
46              
47             =back
48              
49             =head2 NOT IMPORTED CONSTANTS
50              
51             =over 4
52              
53             =item TRUE, FALSE, VOID
54              
55             1, 0, '' values
56              
57             =item OK, DONE, ERROR, SKIPPED, PASSED, FAILED, UNKNOWN, PROBLEM
58              
59             Test result statuses
60              
61             =back
62              
63             =head1 HISTORY
64              
65             See C file
66              
67             =head1 TO DO
68              
69             See C file
70              
71             =head1 AUTHOR
72              
73             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
74              
75             =head1 COPYRIGHT
76              
77             Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved
78              
79             =head1 LICENSE
80              
81             This program is free software; you can redistribute it and/or
82             modify it under the same terms as Perl itself.
83              
84             See C file and L
85              
86             =cut
87              
88 2     2   62 use vars qw/$VERSION @EXPORT @EXPORT_OK/;
  2         3  
  2         126  
89             $VERSION = '1.00';
90              
91 2     2   746 use Sys::Hostname qw/hostname/;
  2         1689  
  2         95  
92 2     2   375 use Try::Tiny;
  2         1601  
  2         89  
93              
94 2     2   11 use base qw/Exporter/;
  2         4  
  2         213  
95              
96             use constant {
97 2 50       712 PROJECTNAME => "MonM",
98             PROJECTNAMEL => "monm",
99             PREFIX => "monm",
100              
101             # TTY
102             IS_TTY => (-t STDOUT) ? 1 : 0,
103             SCREENWIDTH_DEFAULT => 80,
104              
105             # BOOLEAN
106             TRUE => 1,
107             FALSE => 0,
108             VOID => '',
109              
110             # Test results
111             OK => "OK", # for SMALL operations
112             DONE => "DONE", # for LONG operations
113             ERROR => "ERROR", # for operations
114             SKIPPED => "SKIPPED", # for tests
115             PASSED => "PASSED", # for tests
116             FAILED => "FAILED", # for tests
117             UNKNOWN => "UNKNOWN", # for tests
118             PROBLEM => "PROBLEM", # for tests
119 2     2   11 };
  2         17  
120              
121             @EXPORT = (qw/
122             PROJECTNAME
123             PROJECTNAMEL
124             PREFIX
125             HOSTNAME
126             IS_TTY
127             SCREENWIDTH
128             /);
129             @EXPORT_OK = (qw/
130             TRUE FALSE VOID
131             OK DONE ERROR SKIPPED PASSED FAILED UNKNOWN PROBLEM
132             /);
133              
134             my $myhostname = undef;
135             *HOSTNAME = sub {
136 0   0 0     $myhostname ||= (hostname() // 'unknown host');
      0        
137 0           return $myhostname;
138             };
139              
140             my $myscreenw = undef;
141             *SCREENWIDTH = sub {
142 0 0   0     return $myscreenw if defined $myscreenw;
143 0           if (IS_TTY) {
144             try {
145 0     0     require Term::ReadKey;
146 0           my $w = (Term::ReadKey::GetTerminalSize())[0];
147 0 0         $myscreenw = $w < SCREENWIDTH_DEFAULT ? SCREENWIDTH_DEFAULT : $w;
148             } catch {
149 0     0     $myscreenw = SCREENWIDTH_DEFAULT;
150             };
151             } else {
152 0           $myscreenw = SCREENWIDTH_DEFAULT;
153             }
154 0           return $myscreenw;
155             };
156              
157             1;
158              
159             __END__