view release on metacpan or  search on metacpan

lib/CPAN/Shell.pm  view on Meta::CPAN

            }
            $colorize_output = 0;
        }
        return $colorize_output;
    }
}


#-> sub CPAN::Shell::print_ornamented ;
sub print_ornamented {
    my($self,$what,$ornament) = @_;
    return unless defined $what;

    local $| = 1; # Flush immediately
    if ( $CPAN::Be_Silent ) {
        # WARNING: variable Be_Silent is poisoned and must be eliminated.
        print {report_fh()} $what;
        return;
    }
    my $swhat = "$what"; # stringify if it is an object
    if ($CPAN::Config->{term_is_latin}) {
        # note: deprecated, need to switch to $LANG and $LC_*
        # courtesy jhi:
        $swhat
            =~ s{([\xC0-\xDF])([\x80-\xBF])}{chr(ord($1)<<6&0xC0|ord($2)&0x3F)}eg; #};
    }
    if ($self->colorize_output) {
        if ( $CPAN::DEBUG && $swhat =~ /^Debug\(/ ) {
            # if you want to have this configurable, please file a bug report
            $ornament = $CPAN::Config->{colorize_debug} || "black on_cyan";
        }
        my $color_on = eval { Term::ANSIColor::color($ornament) } || "";
        if ($@) {
            print "Term::ANSIColor rejects color[$ornament]: $@\n
Please choose a different color (Hint: try 'o conf init /color/')\n";
        }
        # GGOLDBACH/Test-GreaterVersion-0.008 broke without this
        # $trailer construct. We want the newline be the last thing if
        # there is a newline at the end ensuring that the next line is
        # empty for other players
        my $trailer = "";
        $trailer = $1 if $swhat =~ s/([\r\n]+)\z//;
        print $color_on,
            $swhat,
                Term::ANSIColor::color("reset"),
                      $trailer;
    } else {
        print $swhat;
    }
}

#-> sub CPAN::Shell::myprint ;

# where is myprint/mywarn/Frontend/etc. documented? Where to use what?
# I think, we send everything to STDOUT and use print for normal/good
# news and warn for news that need more attention. Yes, this is our
# working contract for now.
sub myprint {
    my($self,$what) = @_;
    $self->print_ornamented($what,
                            $CPAN::Config->{colorize_print}||'bold blue on_white',
                           );
}

my %already_printed;
#-> sub CPAN::Shell::mywarnonce ;
sub myprintonce {
    my($self,$what) = @_;
    $self->myprint($what) unless $already_printed{$what}++;
}

sub optprint {
    my($self,$category,$what) = @_;
    my $vname = $category . "_verbosity";
    CPAN::HandleConfig->load unless $CPAN::Config_loaded++;
    if (!$CPAN::Config->{$vname}
        || $CPAN::Config->{$vname} =~ /^v/
       ) {
        $CPAN::Frontend->myprint($what);
    }
}

#-> sub CPAN::Shell::myexit ;
sub myexit {
    my($self,$what) = @_;
    $self->myprint($what);
    exit;
}

#-> sub CPAN::Shell::mywarn ;
sub mywarn {
    my($self,$what) = @_;
    $self->print_ornamented($what, $CPAN::Config->{colorize_warn}||'bold red on_white');
}

my %already_warned;
#-> sub CPAN::Shell::mywarnonce ;
sub mywarnonce {
    my($self,$what) = @_;
    $self->mywarn($what) unless $already_warned{$what}++;
}

# only to be used for shell commands
#-> sub CPAN::Shell::mydie ;
sub mydie {
    my($self,$what) = @_;
    $self->mywarn($what);

    # If it is the shell, we want the following die to be silent,
    # but if it is not the shell, we would need a 'die $what'. We need
    # to take care that only shell commands use mydie. Is this
    # possible?

    die "\n";
}

# sub CPAN::Shell::colorable_makemaker_prompt ;
sub colorable_makemaker_prompt {
    my($foo,$bar,$ornament) = @_;
    $ornament ||= "colorize_print";
    if (CPAN::Shell->colorize_output) {
        my $ornament = $CPAN::Config->{$ornament}||'bold blue on_white';
        my $color_on = eval { Term::ANSIColor::color($ornament); } || "";
        print $color_on;
    }
    my $ans = ExtUtils::MakeMaker::prompt($foo,$bar);
    if (CPAN::Shell->colorize_output) {
        print Term::ANSIColor::color('reset');
    }
    return $ans;
}

# use this only for unrecoverable errors!
#-> sub CPAN::Shell::unrecoverable_error ;
sub unrecoverable_error {
    my($self,$what) = @_;
    my @lines = split /\n/, $what;
    my $longest = 0;
    for my $l (@lines) {
        $longest = length $l if length $l > $longest;
    }
    $longest = 62 if $longest > 62;
    for my $l (@lines) {
        if ($l =~ /^\s*$/) {
            $l = "\n";
            next;
        }
        $l = "==> $l";
        if (length $l < 66) {
            $l = pack "A66 A*", $l, "<==";
        }
        $l .= "\n";
    }
    unshift @lines, "\n";
    $self->mydie(join "", @lines);
}

#-> sub CPAN::Shell::mysleep ;
sub mysleep {
    return if $ENV{AUTOMATED_TESTING} || ! -t STDOUT;
    my($self, $sleep) = @_;
    if (CPAN->has_inst("Time::HiRes")) {
        Time::HiRes::sleep($sleep);
    } else {
        sleep($sleep < 1 ? 1 : int($sleep + 0.5));
    }
}

#-> sub CPAN::Shell::setup_output ;
sub setup_output {
    return if -t STDOUT;
    my $odef = select STDERR;
    $| = 1;
    select STDOUT;
    $| = 1;
    select $odef;
}

#-> sub CPAN::Shell::rematein ;
# RE-adme||MA-ke||TE-st||IN-stall : nearly everything runs through here
sub rematein {
    my $self = shift;