diff options
| -rwxr-xr-x | configure | 5 | ||||
| -rw-r--r-- | make/configure.pm | 20 | ||||
| -rw-r--r-- | make/console.pm | 113 | ||||
| -rw-r--r-- | make/utilities.pm | 37 | ||||
| -rwxr-xr-x | tools/genssl | 1 |
5 files changed, 127 insertions, 49 deletions
@@ -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 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/) { diff --git a/tools/genssl b/tools/genssl index 073caa8f4..13b1f01fc 100755 --- 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>); |