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.
This commit is contained in:
Peter Powell 2014-10-01 19:52:23 +01:00
parent 48f8f79317
commit 11f4d02e70
5 changed files with 127 additions and 49 deletions

5
configure vendored
View File

@ -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.

View File

@ -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";
}

113
make/console.pm Normal file
View File

@ -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;

View File

@ -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/) {

View File

@ -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>);