Add Perl module for console related code.

- Move prompt_* methods to this module.
- Add methods for printing errors and warnings easily.
- Add colour code helpers and switch all code to use them.

1 files changed, 113 insertions, 0 deletions

diff --git a/make/console.pm b/make/console.pm
new file mode 100644
index 000000000..9be5ef47c
--- /dev/null
+++ b/make/console.pm
@@ -0,0 +1,113 @@
+#
+# InspIRCd -- Internet Relay Chat Daemon
+#
+#   Copyright (C) 2014 Peter Powell <petpow@saberuk.com>
+#
+# 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
+# License as published by the Free Software Foundation, version 2.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+# details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+
+
+package make::console;
+
+BEGIN {
+	require 5.8.0;
+}
+
+use strict;
+use warnings FATAL => qw(all);
+
+use File::Path            qw(mkpath);
+use File::Spec::Functions qw(rel2abs);
+use Exporter              qw(import);
+
+our @EXPORT = qw(print_format
+                 print_error
+                 print_warning
+                 prompt_bool
+                 prompt_dir
+                 prompt_string);
+
+my %FORMAT_CODES = (
+	DEFAULT => "\e[0m",
+	BOLD    => "\e[1m",
+
+	RED    => "\e[1;31m",
+	GREEN  => "\e[1;32m",
+	YELLOW => "\e[1;33m",
+	BLUE   => "\e[1;34m"
+);
+
+sub __console_format($$) {
+	my ($name, $data) = @_;
+	return $data unless -t STDOUT;
+	return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
+}
+
+sub print_format($;$) {
+	my $message = shift;
+	my $stream = shift || *STDOUT;
+	while ($message =~ /(<\|(\S+)\s(.+?)\|>)/) {
+		my $formatted = __console_format $2, $3;
+		$message =~ s/\Q$1\E/$formatted/;
+	}
+	print { $stream } $message;
+}
+
+sub print_error($) {
+	my $message = shift;
+	print_format "<|RED Error:|> $message\n", *STDERR;
+	exit 1;
+}
+
+sub print_warning($) {
+	my $message = shift;
+	print_format "<|YELLOW Warning:|> $message\n", *STDERR;
+}
+
+sub prompt_bool($$$) {
+	my ($interactive, $question, $default) = @_;
+	my $answer = prompt_string($interactive, $question, $default ? 'y' : 'n');
+	return $answer =~ /y/i;
+}
+
+sub prompt_dir($$$) {
+	my ($interactive, $question, $default) = @_;
+	my ($answer, $create);
+	do {
+		$answer = rel2abs(prompt_string($interactive, $question, $default));
+		$create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
+		if ($create) {
+			my $mkpath = eval {
+				mkpath($answer, 0, 0750);
+				return 1;
+			};
+			unless (defined $mkpath) {
+				print_warning "unable to create $answer!\n";
+				$create = 0;
+			}
+		}
+	} while (!$create);
+	return $answer;
+}
+
+sub prompt_string($$$) {
+	my ($interactive, $question, $default) = @_;
+	return $default unless $interactive;
+	print_format "$question\n";
+	print_format "[<|GREEN $default|>] => ";
+	chomp(my $answer = <STDIN>);
+	print "\n";
+	return $answer ? $answer : $default;
+}
+
+1;