#
# InspIRCd -- Internet Relay Chat Daemon
#
-# Copyright (C) 2014 Peter Powell <petpow@saberuk.com>
+# Copyright (C) 2014-2017, 2019-2021 Sadie Powell <sadie@witchery.services>
#
# 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
package make::console;
-BEGIN {
- require 5.8.0;
-}
-
+use v5.10.0;
use strict;
use warnings FATAL => qw(all);
+use Class::Struct qw(struct);
+use Exporter qw(import);
use File::Path qw(mkpath);
use File::Spec::Functions qw(rel2abs);
-use Exporter qw(import);
-our @EXPORT = qw(print_format
+our @EXPORT = qw(command
+ execute_command
+ console_format
print_error
print_warning
prompt_bool
prompt_string);
my %FORMAT_CODES = (
- DEFAULT => "\e[0m",
- BOLD => "\e[1m",
+ DEFAULT => "\e[0m",
+ BOLD => "\e[1m",
+ UNDERLINE => "\e[4m",
RED => "\e[1;31m",
GREEN => "\e[1;32m",
BLUE => "\e[1;34m"
);
-sub __console_format($$) {
- my ($name, $data) = @_;
- return $data unless -t STDOUT;
- return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
-}
+my %commands;
-sub print_format($;$) {
+struct 'command' => {
+ 'callback' => '$',
+ 'description' => '$',
+};
+
+sub console_format($) {
my $message = shift;
- my $stream = shift || *STDOUT;
- while ($message =~ /(<\|(\S+)\s(.+?)\|>)/) {
- my $formatted = __console_format $2, $3;
- $message =~ s/\Q$1\E/$formatted/;
+ while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
+ my ($match, $type, $text) = ($1, uc $2, $3);
+ if (-t STDOUT && exists $FORMAT_CODES{$type}) {
+ $message =~ s/\Q$match\E/$FORMAT_CODES{$type}$text$FORMAT_CODES{DEFAULT}/;
+ } else {
+ $message =~ s/\Q$match\E/$text/;
+ }
}
- print { $stream } $message;
+ return $message;
}
-sub print_error($) {
- my $message = shift;
- print_format "<|RED Error:|> $message\n", *STDERR;
+sub print_error {
+ print STDERR console_format "<|RED Error:|> ";
+ for my $line (@_) {
+ say STDERR console_format $line;
+ }
exit 1;
}
-sub print_warning($) {
- my $message = shift;
- print_format "<|YELLOW Warning:|> $message\n", *STDERR;
+sub print_warning {
+ print STDERR console_format "<|YELLOW Warning:|> ";
+ for my $line (@_) {
+ say STDERR console_format $line;
+ }
}
sub prompt_bool($$$) {
my ($interactive, $question, $default) = @_;
- my $answer = prompt_string($interactive, $question, $default ? 'y' : 'n');
- return $answer =~ /y/i;
+ while (1) {
+ my $answer = prompt_string($interactive, $question, $default ? 'yes' : 'no');
+ return 1 if $answer =~ /^y(?:es)?$/i;
+ return 0 if $answer =~ /^no?$/i;
+ print_warning "\"$answer\" is not \"yes\" or \"no\". Please try again.\n";
+ }
}
sub prompt_dir($$$;$) {
$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";
+ unless (create_directory $answer, 0750) {
+ print_warning "unable to create $answer: $!\n";
$create = 0;
}
}
sub prompt_string($$$) {
my ($interactive, $question, $default) = @_;
return $default unless $interactive;
- print_format "$question\n";
- print_format "[<|GREEN $default|>] => ";
+ say console_format $question;
+ print console_format "[<|GREEN $default|>] => ";
chomp(my $answer = <STDIN>);
- print "\n";
+ say '';
return $answer ? $answer : $default;
}
+sub command($$$) {
+ my ($name, $description, $callback) = @_;
+ $commands{$name} = command->new;
+ $commands{$name}->callback($callback);
+ $commands{$name}->description($description);
+}
+
+sub command_alias($$) {
+ my ($source, $target) = @_;
+ command $source, undef, sub(@) {
+ execute_command $target, @_;
+ };
+}
+
+sub execute_command(@) {
+ my $command = defined $_[0] ? lc shift : 'help';
+ if ($command eq 'help') {
+ say console_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]";
+ say '';
+ say console_format "<|GREEN Commands:|>";
+ for my $key (sort keys %commands) {
+ next unless defined $commands{$key}->description;
+ my $name = sprintf "%-15s", $key;
+ my $description = $commands{$key}->description;
+ say console_format " <|BOLD $name|> # $description";
+ }
+ exit 0;
+ } elsif (!$commands{$command}) {
+ print_error "no command called <|BOLD $command|> exists!",
+ "See <|BOLD $0 help|> for a list of commands.";
+ } else {
+ return $commands{$command}->callback->(@_);
+ }
+}
+
1;