2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2014-2017, 2019 Sadie Powell <sadie@witchery.services>
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 Class::Struct qw(struct);
31 use Exporter qw(import);
32 use File::Path qw(mkpath);
33 use File::Spec::Functions qw(rel2abs);
35 our @EXPORT = qw(command
63 sub console_format($) {
65 while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
66 my ($match, $type, $text) = ($1, uc $2, $3);
67 if (-t STDOUT && exists $FORMAT_CODES{$type}) {
68 $message =~ s/\Q$match\E/$FORMAT_CODES{$type}$text$FORMAT_CODES{DEFAULT}/;
70 $message =~ s/\Q$match\E/$text/;
76 sub print_format($;$) {
78 my $stream = shift // *STDOUT;
79 print { $stream } console_format $message;
83 print_format "<|RED Error:|> ", *STDERR;
85 print_format "$line\n", *STDERR;
91 print_format "<|YELLOW Warning:|> ", *STDERR;
93 print_format "$line\n", *STDERR;
97 sub prompt_bool($$$) {
98 my ($interactive, $question, $default) = @_;
100 my $answer = prompt_string($interactive, $question, $default ? 'yes' : 'no');
101 return 1 if $answer =~ /^y(?:es)?$/i;
102 return 0 if $answer =~ /^no?$/i;
103 print_warning "\"$answer\" is not \"yes\" or \"no\". Please try again.\n";
107 sub prompt_dir($$$;$) {
108 my ($interactive, $question, $default, $create_now) = @_;
109 my ($answer, $create);
111 $answer = rel2abs(prompt_string($interactive, $question, $default));
112 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
113 if ($create && $create_now) {
114 unless (create_directory $answer, 0750) {
115 print_warning "unable to create $answer: $!\n";
123 sub prompt_string($$$) {
124 my ($interactive, $question, $default) = @_;
125 return $default unless $interactive;
126 print_format "$question\n";
127 print_format "[<|GREEN $default|>] => ";
128 chomp(my $answer = <STDIN>);
130 return $answer ? $answer : $default;
134 my ($name, $description, $callback) = @_;
135 $commands{$name} = command->new;
136 $commands{$name}->callback($callback);
137 $commands{$name}->description($description);
140 sub command_alias($$) {
141 my ($source, $target) = @_;
142 command $source, undef, sub(@) {
143 execute_command $target, @_;
147 sub execute_command(@) {
148 my $command = defined $_[0] ? lc shift : 'help';
149 if ($command eq 'help') {
150 print_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]\n\n";
151 print_format "<|GREEN Commands:|>\n";
152 for my $key (sort keys %commands) {
153 next unless defined $commands{$key}->description;
154 my $name = sprintf "%-15s", $key;
155 my $description = $commands{$key}->description;
156 print_format " <|BOLD $name|> # $description\n";
159 } elsif (!$commands{$command}) {
160 print_error "no command called <|BOLD $command|> exists!",
161 "See <|BOLD $0 help|> for a list of commands.";
163 return $commands{$command}->callback->(@_);