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.

3 files changed, 123 insertions, 47 deletions

diff --git a/make/configure.pm b/make/configure.pm
index 905233835..d04a0b645 100644
--- a/make/configure.pm
+++ b/make/configure.pm
@@ -34,6 +34,7 @@ use Cwd 'getcwd';
 use Exporter 'import';
 use File::Basename 'basename';
 
+use make::console;
 use make::utilities;
 
 our @EXPORT = qw(cmd_clean cmd_help cmd_update
@@ -150,10 +151,7 @@ EOH
 }
 
 sub cmd_update {
-	unless (-f '.config.cache') {
-		print "You have not run $0 before. Please do this before trying to update the build files.\n";
-		exit 1;
-	}
+	print_error "You have not run $0 before. Please do this before trying to update the generated files." unless -f '.config.cache';
 	print "Updating...\n";
 	my %config = read_configure_cache();
 	my %compiler = get_compiler_info($config{CXX});
@@ -290,8 +288,8 @@ sub parse_templates($$) {
 
 	# Iterate through files in make/template.
 	foreach (<make/template/*>) {
-		print "Parsing $_...\n";
-		open(TEMPLATE, $_);
+		print_format "Parsing <|GREEN $_|> ...\n";
+		open(TEMPLATE, $_) or print_error "unable to read $_: $!";
 		my (@lines, $mode, @platforms, %targets);
 
 		# First pass: parse template variables and directives.
@@ -304,7 +302,7 @@ sub parse_templates($$) {
 				if (defined $settings{$name}) {
 					$line =~ s/$variable/$settings{$name}/;
 				} else {
-					print STDERR "Warning: unknown template variable '$name' in $_!\n";
+					print_warning "unknown template variable '$name' in $_!";
 					last;
 				}
 			}
@@ -328,7 +326,7 @@ sub parse_templates($$) {
 						$targets{DEFAULT} = $2;
 					}
 				} else {
-					print STDERR "Warning: unknown template command '$1' in $_!\n";
+					print_warning "unknown template command '$1' in $_!";
 					push @lines, $line;
 				}
 				next;
@@ -413,7 +411,7 @@ sub parse_templates($$) {
 							# HACK: silently ignore if lower case as these are probably make commands.
 							push @final_lines, $line;
 						} else {
-							print STDERR "Warning: unknown template command '$1' in $_!\n";
+							print_warning "unknown template command '$1' in $_!";
 							push @final_lines, $line;
 						}
 						next;
@@ -423,8 +421,8 @@ sub parse_templates($$) {
 				}
 
 				# Write the template file.
-				print "Writing $target...\n";
-				open(TARGET, ">$target");
+				print_format "Writing <|GREEN $target|> ...\n";
+				open(TARGET, '>', $target) or print_error "unable to write $_: $!";
 				foreach (@final_lines) {
 					print TARGET $_, "\n";
 				}
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;
diff --git a/make/utilities.pm b/make/utilities.pm
index 7db557d11..4103e38f3 100644
--- a/make/utilities.pm
+++ b/make/utilities.pm
@@ -32,11 +32,10 @@ use warnings FATAL => qw(all);
 use Exporter 'import';
 use Fcntl;
 use File::Path;
-use File::Spec::Functions qw(rel2abs);
 use Getopt::Long;
 use POSIX;
 
-our @EXPORT = qw(get_version module_installed prompt_bool prompt_dir prompt_string get_cpu_count make_rpath pkgconfig_get_include_dirs pkgconfig_get_lib_dirs pkgconfig_check_version translate_functions promptstring);
+our @EXPORT = qw(get_version module_installed get_cpu_count make_rpath pkgconfig_get_include_dirs pkgconfig_get_lib_dirs pkgconfig_check_version translate_functions promptstring);
 
 my %already_added = ();
 my %version = ();
@@ -79,40 +78,6 @@ sub module_installed($) {
 	return !$@;
 }
 
-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) = (undef, 'y');
-	do {
-		$answer = rel2abs(prompt_string($interactive, $question, $default));
-		$create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
-		my $mkpath = eval {
-			mkpath($answer, 0, 0750);
-			return 1;
-		};
-		unless (defined $mkpath) {
-			print "Error: unable to create $answer!\n\n";
-			$create = 0;
-		}
-	} while (!$create);
-	return $answer;
-}
-
-sub prompt_string($$$) {
-	my ($interactive, $question, $default) = @_;
-	return $default unless $interactive;
-	print $question, "\n";
-	print "[\e[1;32m$default\e[0m] => ";
-	chomp(my $answer = <STDIN>);
-	print "\n";
-	return $answer ? $answer : $default;
-}
-
 sub get_cpu_count {
 	my $count = 1;
 	if ($^O =~ /bsd/) {