[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / Shell.pm

package CPANPLUS::Shell;

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

$DEFAULT    = SHELL_DEFAULT;

=pod

=head1 NAME

CPANPLUS::Shell

=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;
    ### XXX this should offer to reconfigure CPANPLUS, somehow.  --rs
    my $conf    = CPANPLUS::Configure->new() 
                    or die loc("No configuration available -- aborting") . $/;

    ### find out what shell we're supposed to load ###
    $SHELL      = $option
                    ? $class . '::' . $option
                    : $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 => [ ] },
    _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);

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

1;

=pod

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 COPYRIGHT

The CPAN++ interface (of which this module is a part of) is copyright (c) 
2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<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:
Commit	Line	Data
6aaee015	1	package CPANPLUS::Shell;
	2
	3	use strict;
	4
	5	use CPANPLUS::Error;
	6	use CPANPLUS::Configure;
494f1016	7	use CPANPLUS::Internals::Constants;
6aaee015	8
	9	use Module::Load qw[load];
	10	use Params::Check qw[check];
	11	use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
	12
	13	$Params::Check::VERBOSE = 1;
	14
	15	use vars qw[@ISA $SHELL $DEFAULT];
	16
494f1016	17	$DEFAULT = SHELL_DEFAULT;
6aaee015	18
	19	=pod
	20
	21	=head1 NAME
	22
	23	CPANPLUS::Shell
	24
	25	=head1 SYNOPSIS
	26
	27	use CPANPLUS::Shell; # load the shell indicated by your
	28	# config -- defaults to
	29	# CPANPLUS::Shell::Default
	30
	31	use CPANPLUS::Shell qw[Classic] # load CPANPLUS::Shell::Classic;
	32
	33	my $ui = CPANPLUS::Shell->new();
	34	my $name = $ui->which; # Find out what shell you loaded
	35
	36	$ui->shell; # run the ui shell
	37
	38
	39	=head1 DESCRIPTION
	40
	41	This module is the generic loading (and base class) for all C<CPANPLUS>
	42	shells. Through this module you can load any installed C<CPANPLUS>
	43	shell.
	44
	45	Just about all the functionality is provided by the shell that you have
	46	loaded, and not by this class (which merely functions as a generic
	47	loading class), so please consult the documentation of your shell of
	48	choice.
	49
	50	=cut
	51
	52
	53	sub import {
	54	my $class = shift;
	55	my $option = shift;
	56	### XXX this should offer to reconfigure CPANPLUS, somehow. --rs
	57	my $conf = CPANPLUS::Configure->new()
	58	or die loc("No configuration available -- aborting") . $/;
	59
	60	### find out what shell we're supposed to load ###
	61	$SHELL = $option
	62	? $class . '::' . $option
	63	: $conf->get_conf('shell') \|\| $DEFAULT;
	64
	65	### load the shell, fall back to the default if required
	66	### and die if even that doesn't work
	67	EVAL: {
	68	eval { load $SHELL };
	69
	70	if( $@ ) {
	71	my $err = $@;
	72
	73	die loc("Your default shell '%1' is not available: %2",
	74	$DEFAULT, $err) .
	75	loc("Check your installation!") . "\n"
	76	if $SHELL eq $DEFAULT;
	77
	78	warn loc("Failed to use '%1': %2", $SHELL, $err),
	79	loc("Switching back to the default shell '%1'", $DEFAULT),
	80	"\n";
	81
82	$SHELL = $DEFAULT;
83	redo EVAL;
84	}
85	}
86	@ISA = ($SHELL);
87	}
88
89	sub which { return $SHELL }
90
91	1;
92
93	###########################################################################
94	### abstracted out subroutines available to programmers of other shells ###
95	###########################################################################
96
97	package CPANPLUS::Shell::_Base::ReadLine;
98
99	use strict;
100	use vars qw($AUTOLOAD $TMPL);
101
102	use FileHandle;
103	use CPANPLUS::Error;
104	use Params::Check qw[check];
105	use Module::Load::Conditional qw[can_load];
106	use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
107
108	$Params::Check::VERBOSE = 1;
109
110
111	$TMPL = {
112	brand => { default => '', strict_type => 1 },
113	prompt => { default => '> ', strict_type => 1 },
114	pager => { default => '' },
115	backend => { default => '' },
116	term => { default => '' },
117	format => { default => '' },
118	dist_format => { default => '' },
119	remote => { default => undef },
120	noninteractive => { default => '' },
121	cache => { default => [ ] },
122	_old_sigpipe => { default => '', no_override => 1 },
123	_old_outfh => { default => '', no_override => 1 },
124	_signals => { default => { INT => { } }, no_override => 1 },
125	};
126
127	### autogenerate accessors ###
128	for my $key ( keys %$TMPL ) {
129	no strict 'refs';
130	*{__PACKAGE__."::$key"} = sub {
131	my $self = shift;
132	$self->{$key} = $_[0] if @_;
133	return $self->{$key};
134	}
135	}
136
137	sub _init {
138	my $class = shift;
139	my %hash = @_;
140
141	my $self = check( $TMPL, \%hash ) or return;
142
143	bless $self, $class;
144
145	### signal handler ###
146	$SIG{INT} = $self->_signals->{INT}->{handler} =
147	sub {
148	unless ( $self->_signals->{INT}->{count}++ ) {
149	warn loc("Caught SIGINT"), "\n";
150	} else {
151	warn loc("Got another SIGINT"), "\n"; die;
152	}
153	};
154	### end sig handler ###
155
156	return $self;
157	}
158
159	### display shell's banner, takes the Backend object as argument
160	sub _show_banner {
161	my $self = shift;
162	my $cpan = $self->backend;
163	my $term = $self->term;
164
165	### Tries to probe for our ReadLine support status
166	# a) under an interactive shell?
167	my $rl_avail = (!$term->isa('CPANPLUS::Shell::_Faked'))
168	# b) do we have a tty terminal?
169	? (-t STDIN)
170	# c) should we enable the term?
171	? (!$self->__is_bad_terminal($term))
172	# d) external modules available?
173	? ($term->ReadLine ne "Term::ReadLine::Stub")
174	# a+b+c+d => "Smart" terminal
175	? loc("enabled")
176	# a+b+c => "Stub" terminal
177	: loc("available (try 'i Term::ReadLine::Perl')")
178	# a+b => "Bad" terminal
179	: loc("disabled")
180	# a => "Dumb" terminal
181	: loc("suppressed")
182	# none => "Faked" terminal
183	: loc("suppressed in batch mode");
184
185	$rl_avail = loc("ReadLine support %1.", $rl_avail);
186	$rl_avail = "\n*** $rl_avail" if (length($rl_avail) > 45);
187
188	print loc("%1 -- CPAN exploration and module installation (v%2)",
189	$self->which, $self->which->VERSION()), "\n",
190	loc("*** Please report bugs to <bug-cpanplus\@rt.cpan.org>."), "\n",
191	loc("*** Using CPANPLUS::Backend v%1. %2",
192	$cpan->VERSION, $rl_avail), "\n\n";
193	}
194
195	### checks whether the Term::ReadLine is broken and needs to fallback to Stub
196	sub __is_bad_terminal {
197	my $self = shift;
198	my $term = $self->term;
199
200	return unless $^O eq 'MSWin32';
201
202	### replace the term with the default (stub) one
203	return $self->term(Term::ReadLine::Stub->new( $self->brand ) );
204	}
205
206	### open a pager handle
207	sub _pager_open {
208	my $self = shift;
209	my $cpan = $self->backend;
210	my $cmd = $cpan->configure_object->get_program('pager') or return;
211
212	$self->_old_sigpipe( $SIG{PIPE} );
213	$SIG{PIPE} = 'IGNORE';
214
215	my $fh = new FileHandle;
216	unless ( $fh->open("\| $cmd") ) {
217	error(loc("could not pipe to %1: %2\n", $cmd, $!) );
218	return;
219	}
220
221	$fh->autoflush(1);
222
223	$self->pager( $fh );
224	$self->_old_outfh( select $fh );
225
226	return $fh;
227	}
228
229	### print to the current pager handle, or STDOUT if it's not opened
230	sub _pager_close {
231	my $self = shift;
232	my $pager = $self->pager or return;
233
234	$pager->close if (ref($pager) and $pager->can('close'));
235
236	$self->pager( undef );
237
238	select $self->_old_outfh;
239	$SIG{PIPE} = $self->_old_sigpipe;
240
241	return 1;
242	}
243
244
245
246	{
247	my $win32_console;
248
249	### determines row count of current terminal; defaults to 25.
250	### used by the pager functions
251	sub _term_rowcount {
252	my $self = shift;
253	my $cpan = $self->backend;
254	my %hash = @_;
255
256	my $default;
257	my $tmpl = {
258	default => { default => 25, allow => qr/^\d$/,
259	store => \$default }
260	};
261
262	check( $tmpl, \%hash ) or return;
263
264	if ( $^O eq 'MSWin32' ) {
265	if ( can_load( modules => { 'Win32::Console' => '0.0' } ) ) {
266	$win32_console \|\|= Win32::Console->new();
267	my $rows = ($win32_console->Info)[-1];
268	return $rows;
269	}
270
271	} else {
272	local $Module::Load::Conditional::VERBOSE = 0;
273	if ( can_load(modules => {'Term::Size' => '0.0'}) ) {
274	my ($cols, $rows) = Term::Size::chars();
275	return $rows;
276	}
277	}
278	return $default;
279	}
280	}
281
282	1;
283
284	=pod
285
286	=head1 BUG REPORTS
287
288	Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
289
290	=head1 AUTHOR
291
292	This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
293
294	=head1 COPYRIGHT
295
296	The CPAN++ interface (of which this module is a part of) is copyright (c)
297	2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
298
299	This library is free software; you may redistribute and/or modify it
300	under the same terms as Perl itself.
301
302	=head1 SEE ALSO
303
304	L<CPANPLUS::Shell::Default>, L<CPANPLUS::Shell::Classic>, L<cpanp>
305
306	=cut
307
308	# Local variables:
309	# c-indentation-style: bsd
310	# c-basic-offset: 4
311	# indent-tabs-mode: nil
312	# End:
313	# vim: expandtab shiftwidth=4:
314