2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2014-2017 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 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
62 sub __console_format($$) {
63 my ($name, $data) = @_;
64 return $data unless -t STDOUT;
65 return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
68 sub print_format($;$) {
70 my $stream = shift // *STDOUT;
71 while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
72 my $formatted = __console_format $2, $3;
73 $message =~ s/\Q$1\E/$formatted/;
75 print { $stream } $message;
79 print_format "<|RED Error:|> ", *STDERR;
81 print_format "$line\n", *STDERR;
87 print_format "<|YELLOW Warning:|> ", *STDERR;
89 print_format "$line\n", *STDERR;
93 sub prompt_bool($$$) {
94 my ($interactive, $question, $default) = @_;
95 my $answer = prompt_string($interactive, $question, $default ? 'y' : 'n');
96 return $answer =~ /y/i;
99 sub prompt_dir($$$;$) {
100 my ($interactive, $question, $default, $create_now) = @_;
101 my ($answer, $create);
103 $answer = rel2abs(prompt_string($interactive, $question, $default));
104 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
105 if ($create && $create_now) {
106 unless (create_directory $answer, 0750) {
107 print_warning "unable to create $answer: $!\n";
115 sub prompt_string($$$) {
116 my ($interactive, $question, $default) = @_;
117 return $default unless $interactive;
118 print_format "$question\n";
119 print_format "[<|GREEN $default|>] => ";
120 chomp(my $answer = <STDIN>);
122 return $answer ? $answer : $default;
126 my ($name, $description, $callback) = @_;
127 $commands{$name} = command->new;
128 $commands{$name}->callback($callback);
129 $commands{$name}->description($description);
132 sub command_alias($$) {
133 my ($source, $target) = @_;
134 command $source, undef, sub(@) {
135 execute_command $target, @_;
139 sub execute_command(@) {
140 my $command = defined $_[0] ? lc shift : 'help';
141 if ($command eq 'help') {
142 print_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]\n\n";
143 print_format "<|GREEN Commands:|>\n";
144 for my $key (sort keys %commands) {
145 next unless defined $commands{$key}->description;
146 my $name = sprintf "%-15s", $key;
147 my $description = $commands{$key}->description;
148 print_format " <|BOLD $name|> # $description\n";
151 } elsif (!$commands{$command}) {
152 print_error "no command called <|BOLD $command|> exists!",
153 "See <|BOLD $0 help|> for a list of commands.";
155 return $commands{$command}->callback->(@_);