make/console.pm

   1 #
   2 # InspIRCd -- Internet Relay Chat Daemon
   3 #
   4 #   Copyright (C) 2014-2017, 2019-2021 Sadie Powell <sadie@witchery.services>
   5 #
   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.
   9 #
  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
  13 # details.
  14 #
  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/>.
  17 #
  18
  19
  20 package make::console;
  21
  22 use v5.10.0;
  23 use strict;
  24 use warnings FATAL => qw(all);
  25
  26 use Class::Struct         qw(struct);
  27 use Exporter              qw(import);
  28 use File::Path            qw(mkpath);
  29 use File::Spec::Functions qw(rel2abs);
  30
  31 our @EXPORT = qw(command
  32                  execute_command
  33                  console_format
  34                  print_error
  35                  print_warning
  36                  prompt_bool
  37                  prompt_dir
  38                  prompt_string);
  39
  40 my %FORMAT_CODES = (
  41         DEFAULT   => "\e[0m",
  42         BOLD      => "\e[1m",
  43         UNDERLINE => "\e[4m",
  44
  45         RED    => "\e[1;31m",
  46         GREEN  => "\e[1;32m",
  47         YELLOW => "\e[1;33m",
  48         BLUE   => "\e[1;34m"
  49 );
  50
  51 my %commands;
  52
  53 struct 'command' => {
  54         'callback'    => '$',
  55         'description' => '$',
  56 };
  57
  58 sub console_format($) {
  59         my $message = shift;
  60         while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
  61                 my ($match, $type, $text) = ($1, uc $2, $3);
  62                 if (-t STDOUT && exists $FORMAT_CODES{$type}) {
  63                         $message =~ s/\Q$match\E/$FORMAT_CODES{$type}$text$FORMAT_CODES{DEFAULT}/;
  64                 } else {
  65                         $message =~ s/\Q$match\E/$text/;
  66                 }
  67         }
  68         return $message;
  69 }
  70
  71 sub print_error {
  72         print STDERR console_format "<|RED Error:|> ";
  73         for my $line (@_) {
  74                 say STDERR console_format $line;
  75         }
  76         exit 1;
  77 }
  78
  79 sub print_warning {
  80         print STDERR console_format "<|YELLOW Warning:|> ";
  81         for my $line (@_) {
  82                 say STDERR console_format $line;
  83         }
  84 }
  85
  86 sub prompt_bool($$$) {
  87         my ($interactive, $question, $default) = @_;
  88         while (1) {
  89                 my $answer = prompt_string($interactive, $question, $default ? 'yes' : 'no');
  90                 return 1 if $answer =~ /^y(?:es)?$/i;
  91                 return 0 if $answer =~ /^no?$/i;
  92                 print_warning "\"$answer\" is not \"yes\" or \"no\". Please try again.\n";
  93         }
  94 }
  95
  96 sub prompt_dir($$$;$) {
  97         my ($interactive, $question, $default, $create_now) = @_;
  98         my ($answer, $create);
  99         do {
 100                 $answer = rel2abs(prompt_string($interactive, $question, $default));
 101                 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
 102                 if ($create && $create_now) {
 103                         unless (create_directory $answer, 0750) {
 104                                 print_warning "unable to create $answer: $!\n";
 105                                 $create = 0;
 106                         }
 107                 }
 108         } while (!$create);
 109         return $answer;
 110 }
 111
 112 sub prompt_string($$$) {
 113         my ($interactive, $question, $default) = @_;
 114         return $default unless $interactive;
 115         say console_format $question;
 116         print console_format "[<|GREEN $default|>] => ";
 117         chomp(my $answer = <STDIN>);
 118         say '';
 119         return $answer ? $answer : $default;
 120 }
 121
 122 sub command($$$) {
 123         my ($name, $description, $callback) = @_;
 124         $commands{$name} = command->new;
 125         $commands{$name}->callback($callback);
 126         $commands{$name}->description($description);
 127 }
 128
 129 sub command_alias($$) {
 130         my ($source, $target) = @_;
 131         command $source, undef, sub(@) {
 132                 execute_command $target, @_;
 133         };
 134 }
 135
 136 sub execute_command(@) {
 137         my $command = defined $_[0] ? lc shift : 'help';
 138         if ($command eq 'help') {
 139                 say console_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]";
 140                 say '';
 141                 say console_format "<|GREEN Commands:|>";
 142                 for my $key (sort keys %commands) {
 143                         next unless defined $commands{$key}->description;
 144                         my $name = sprintf "%-15s", $key;
 145                         my $description = $commands{$key}->description;
 146                         say console_format "  <|BOLD $name|> # $description";
 147                 }
 148                 exit 0;
 149         } elsif (!$commands{$command}) {
 150                 print_error "no command called <|BOLD $command|> exists!",
 151                         "See <|BOLD $0 help|> for a list of commands.";
 152         } else {
 153                 return $commands{$command}->callback->(@_);
 154         }
 155 }
 156
 157 1;