1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#
# InspIRCd -- Internet Relay Chat Daemon
#
# Copyright (C) 2014 Peter Powell <petpow@saberuk.com>
#
# This file is part of InspIRCd. InspIRCd is free software: you can
# redistribute it and/or modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation, version 2.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
package make::console;
BEGIN {
require 5.8.0;
}
use strict;
use warnings FATAL => qw(all);
use File::Path qw(mkpath);
use File::Spec::Functions qw(rel2abs);
use Exporter qw(import);
our @EXPORT = qw(print_format
print_error
print_warning
prompt_bool
prompt_dir
prompt_string);
my %FORMAT_CODES = (
DEFAULT => "\e[0m",
BOLD => "\e[1m",
RED => "\e[1;31m",
GREEN => "\e[1;32m",
YELLOW => "\e[1;33m",
BLUE => "\e[1;34m"
);
sub __console_format($$) {
my ($name, $data) = @_;
return $data unless -t STDOUT;
return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
}
sub print_format($;$) {
my $message = shift;
my $stream = shift || *STDOUT;
while ($message =~ /(<\|(\S+)\s(.+?)\|>)/) {
my $formatted = __console_format $2, $3;
$message =~ s/\Q$1\E/$formatted/;
}
print { $stream } $message;
}
sub print_error($) {
my $message = shift;
print_format "<|RED Error:|> $message\n", *STDERR;
exit 1;
}
sub print_warning($) {
my $message = shift;
print_format "<|YELLOW Warning:|> $message\n", *STDERR;
}
sub prompt_bool($$$) {
my ($interactive, $question, $default) = @_;
my $answer = prompt_string($interactive, $question, $default ? 'y' : 'n');
return $answer =~ /y/i;
}
sub prompt_dir($$$;$) {
my ($interactive, $question, $default, $create_now) = @_;
my ($answer, $create);
do {
$answer = rel2abs(prompt_string($interactive, $question, $default));
$create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
if ($create && $create_now) {
my $mkpath = eval {
mkpath($answer, 0, 0750);
return 1;
};
unless (defined $mkpath) {
print_warning "unable to create $answer!\n";
$create = 0;
}
}
} while (!$create);
return $answer;
}
sub prompt_string($$$) {
my ($interactive, $question, $default) = @_;
return $default unless $interactive;
print_format "$question\n";
print_format "[<|GREEN $default|>] => ";
chomp(my $answer = <STDIN>);
print "\n";
return $answer ? $answer : $default;
}
1;
|
