2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2014 Peter Powell <petpow@saberuk.com>
6 # This file is part of InspIRCd. InspIRCd is free software: you can
7 # redistribute it and/or modify it under the terms of the GNU General Public
8 # License as published by the Free Software Foundation, version 2.
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20 package make::console;
28 use warnings FATAL => qw(all);
30 use File::Path qw(mkpath);
31 use File::Spec::Functions qw(rel2abs);
32 use Exporter qw(import);
34 our @EXPORT = qw(print_format
51 sub __console_format($$) {
52 my ($name, $data) = @_;
53 return $data unless -t STDOUT;
54 return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
57 sub print_format($;$) {
59 my $stream = shift // *STDOUT;
60 while ($message =~ /(<\|(\S+)\s(.+?)\|>)/) {
61 my $formatted = __console_format $2, $3;
62 $message =~ s/\Q$1\E/$formatted/;
64 print { $stream } $message;
69 print_format "<|RED Error:|> $message\n", *STDERR;
73 sub print_warning($) {
75 print_format "<|YELLOW Warning:|> $message\n", *STDERR;
78 sub prompt_bool($$$) {
79 my ($interactive, $question, $default) = @_;
80 my $answer = prompt_string($interactive, $question, $default ? 'y' : 'n');
81 return $answer =~ /y/i;
84 sub prompt_dir($$$;$) {
85 my ($interactive, $question, $default, $create_now) = @_;
86 my ($answer, $create);
88 $answer = rel2abs(prompt_string($interactive, $question, $default));
89 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
90 if ($create && $create_now) {
91 unless (create_directory $answer, 0750) {
92 print_warning "unable to create $answer: $!\n";
100 sub prompt_string($$$) {
101 my ($interactive, $question, $default) = @_;
102 return $default unless $interactive;
103 print_format "$question\n";
104 print_format "[<|GREEN $default|>] => ";
105 chomp(my $answer = <STDIN>);
107 return $answer ? $answer : $default;