package CPANPLUS::Shell;
use deprecate;

use strict;

use CPANPLUS::Error;
use CPANPLUS::Configure;
use CPANPLUS::Internals::Constants;

use Module::Load qw[load];
use Params::Check qw[check];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';

$Params::Check::VERBOSE = 1;

use vars qw[@ISA $SHELL $DEFAULT $VERSION];

$VERSION = "0.9135";
$DEFAULT = SHELL_DEFAULT;

=pod

=head1 NAME

CPANPLUS::Shell - base class for CPANPLUS shells

=head1 SYNOPSIS

use CPANPLUS::Shell; # load the shell indicated by your
# config -- defaults to
# CPANPLUS::Shell::Default

use CPANPLUS::Shell qw[Classic] # load CPANPLUS::Shell::Classic;

my $ui = CPANPLUS::Shell->new();
my $name = $ui->which; # Find out what shell you loaded

$ui->shell; # run the ui shell


=head1 DESCRIPTION

This module is the generic loading (and base class) for all C<CPANPLUS>
shells. Through this module you can load any installed C<CPANPLUS>
shell.

Just about all the functionality is provided by the shell that you have
loaded, and not by this class (which merely functions as a generic
loading class), so please consult the documentation of your shell of
choice.

=cut

sub import {
my $class = shift;
my $option = shift;

### find out what shell we're supposed to load ###
$SHELL = $option
? $class . '::' . $option
: do { ### XXX this should offer to reconfigure
### CPANPLUS, somehow. --rs
### XXX load Configure only if we really have to
### as that means any $Conf passed later on will
### be ignored in favour of the one that was
### retrieved via ->new --kane
my $conf = CPANPLUS::Configure->new() or
die loc("No configuration available -- aborting") . $/;
$conf->get_conf('shell') || $DEFAULT;
};

### load the shell, fall back to the default if required
### and die if even that doesn't work
EVAL: {
eval { load $SHELL };

if( $@ ) {
my $err = $@;

die loc("Your default shell '%1' is not available: %2",
$DEFAULT, $err) .
loc("Check your installation!") . "\n"
if $SHELL eq $DEFAULT;

warn loc("Failed to use '%1': %2", $SHELL, $err),
loc("Switching back to the default shell '%1'", $DEFAULT),
"\n";

$SHELL = $DEFAULT;
redo EVAL;
}
}
@ISA = ($SHELL);
}

sub which { return $SHELL }

1;

###########################################################################
### abstracted out subroutines available to programmers of other shells ###
###########################################################################

package CPANPLUS::Shell::_Base::ReadLine;

use strict;
use vars qw($AUTOLOAD $TMPL);

use FileHandle;
use CPANPLUS::Error;
use Params::Check qw[check];
use Module::Load::Conditional qw[can_load];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';

$Params::Check::VERBOSE = 1;


$TMPL = {
brand => { default => '', strict_type => 1 },
prompt => { default => '> ', strict_type => 1 },
pager => { default => '' },
backend => { default => '' },
term => { default => '' },
format => { default => '' },
dist_format => { default => '' },
remote => { default => undef },
noninteractive => { default => '' },
cache => { default => [ ] },
settings => { default => { install_all_prereqs => undef },
no_override => 1 },
_old_sigpipe => { default => '', no_override => 1 },
_old_outfh => { default => '', no_override => 1 },
_signals => { default => { INT => { } }, no_override => 1 },
};

### autogenerate accessors ###
for my $key ( keys %$TMPL ) {
no strict 'refs';
*{__PACKAGE__."::$key"} = sub {
my $self = shift;
$self->{$key} = $_[0] if @_;
return $self->{$key};
}
}

sub _init {
my $class = shift;
my %hash = @_;

my $self = check( $TMPL, \%hash ) or return;

bless $self, $class;

### signal handler ###
$SIG{INT} = $self->_signals->{INT}->{handler} =
sub {
unless ( $self->_signals->{INT}->{count}++ ) {
warn loc("Caught SIGINT"), "\n";
} else {
warn loc("Got another SIGINT"), "\n"; die;
}
};
### end sig handler ###

return $self;
}

### display shell's banner, takes the Backend object as argument
sub _show_banner {
my $self = shift;
my $cpan = $self->backend;
my $term = $self->term;

### Tries to probe for our ReadLine support status
# a) under an interactive shell?
my $rl_avail = (!$term->isa('CPANPLUS::Shell::_Faked'))
# b) do we have a tty terminal?
? (-t STDIN)
# c) should we enable the term?
? (!$self->__is_bad_terminal($term))
# d) external modules available?
? ($term->ReadLine ne "Term::ReadLine::Stub")
# a+b+c+d => "Smart" terminal
? loc("enabled")
# a+b+c => "Stub" terminal
: loc("available (try 'i Term::ReadLine::Perl')")
# a+b => "Bad" terminal
: loc("disabled")
# a => "Dumb" terminal
: loc("suppressed")
# none => "Faked" terminal
: loc("suppressed in batch mode");

$rl_avail = loc("ReadLine support %1.", $rl_avail);
$rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45);

$self->__print(
loc("%1 -- CPAN exploration and module installation (v%2)",
$self->which, $self->which->VERSION()), "\n",
loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n",
loc("*** Using CPANPLUS::Backend v%1. %2",
$cpan->VERSION, $rl_avail), "\n\n"
);
}

### checks whether the Term::ReadLine is broken and needs to fallback to Stub
sub __is_bad_terminal {
my $self = shift;
my $term = $self->term;

return unless $^O eq 'MSWin32';

### replace the term with the default (stub) one
return $self->term(Term::ReadLine::Stub->new( $self->brand ) );
}

### open a pager handle
sub _pager_open {
my $self = shift;
my $cpan = $self->backend;
my $cmd = $cpan->configure_object->get_program('pager') or return;

$self->_old_sigpipe( $SIG{PIPE} );
$SIG{PIPE} = 'IGNORE';

my $fh = new FileHandle;
unless ( $fh->open("| $cmd") ) {
error(loc("could not pipe to %1: %2\n", $cmd, $!) );
return;
}

$fh->autoflush(1);

$self->pager( $fh );
$self->_old_outfh( select $fh );

return $fh;
}

### print to the current pager handle, or STDOUT if it's not opened
sub _pager_close {
my $self = shift;
my $pager = $self->pager or return;

$pager->close if (ref($pager) and $pager->can('close'));

$self->pager( undef );

select $self->_old_outfh;
$SIG{PIPE} = $self->_old_sigpipe;

return 1;
}



{
my $win32_console;

### determines row count of current terminal; defaults to 25.
### used by the pager functions
sub _term_rowcount {
my $self = shift;
my $cpan = $self->backend;
my %hash = @_;

my $default;
my $tmpl = {
default => { default => 25, allow => qr/^\d$/,
store => \$default }
};

check( $tmpl, \%hash ) or return;

if ( $^O eq 'MSWin32' ) {
if ( can_load( modules => { 'Win32::Console' => '0.0' } ) ) {
$win32_console ||= Win32::Console->new();
my $rows = ($win32_console->Info)[-1];
return $rows;
}

} else {
local $Module::Load::Conditional::VERBOSE = 0;
if ( can_load(modules => {'Term::Size' => '0.0'}) ) {
my ($cols, $rows) = Term::Size::chars();
return $rows;
}
}
return $default;
}
}

### Custom print routines, mainly to be able to catch output
### in test cases, or redirect it if need be
{ sub __print {
my $self = shift;
print @_;
}

sub __printf {
my $self = shift;
my $fmt = shift;

### MUST specify $fmt as a separate param, and not as part
### of @_, as it will then miss the $fmt and return the
### number of elements in the list... =/ --kane
$self->__print( sprintf( $fmt, @_ ) );
}
}

1;

=pod

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>[email protected]<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>[email protected]<gt>.

=head1 COPYRIGHT

The CPAN++ interface (of which this module is a part of) is copyright (c)
2001 - 2007, Jos Boumans E<lt>[email protected]<gt>. All rights reserved.

This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<CPANPLUS::Shell::Default>, L<CPANPLUS::Shell::Classic>, L<cpanp>

=cut

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: