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.

diff --git a/configure b/configure
index 45bb0e911f68f65d20bab8b39ebbe6f513a52880..71424c764afcf75067dcc69319afdbff7e7e05dc 100755 (executable)
--- a/configure
+++ b/configure
@@ -39,6 +39,7 @@ use Cwd;
 use Getopt::Long;
 
 use make::configure;
+use make::console;
 use make::utilities;
 
 our ($opt_use_gnutls, $opt_use_openssl, $opt_nointeractive, $opt_socketengine,
@@ -277,8 +278,8 @@ STOP
 
        # Check that the user actually wants this version.
        if ($version{LABEL} ne 'release') {
-               print <<"EOW" ;
-\e[1;31mWARNING!\e[0m You are building a development version. This contains code which has
+               print_warning <<'EOW';
+You are building a development version. This contains code which has
 not been tested as heavily and may contain various faults which could seriously
 affect the running of your server. It is recommended that you use a stable
 version instead.

diff --git a/make/configure.pm b/make/configure.pm
index 90523383505f24d4fa6caf96bb83e710e84b64fd..d04a0b645d83fc87777df090025492344173e13b 100644 (file)
--- 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 (file)
index 0000000..9be5ef4
--- /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 7db557d1125a86d2b39dcecd285c28a7a84f52a0..4103e38f3c5c23f44a21b617ac5c052a6a03b3a5 100644 (file)
--- 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/) {

diff --git a/tools/genssl b/tools/genssl
index 073caa8f4d8e8e00fa122e3dbe788f099ab2b9ff..13b1f01fc9d6d1f928c6b99654633c19453740bd 100755 (executable)
--- a/tools/genssl
+++ b/tools/genssl
@@ -35,6 +35,7 @@ use File::Temp();
 
 sub prompt($$) {
        my ($question, $default) = @_;
+       return prompt_string(1, $question, $default) if eval 'use make::console; 1';
        print "$question\n";
        print "[$default] => ";
        chomp(my $answer = <STDIN>);