Debconf/FrontEnd/Tty.pm

#!/usr/bin/perl -w

=head1 NAME

Debconf::FrontEnd::Tty - Tty FrontEnd

=cut

package Debconf::FrontEnd::Tty;
use strict;
use Debconf::Gettext;
use base qw(Debconf::FrontEnd);

=head1 DESCRIPTION

This FrontEnd is not useful by itself. It serves as a parent for any FrontEnds
that have a user interface that runs in a tty. The screenheight field is
always set to the current height of the tty, while the screenwidth field is
always set to its width.

=head1 METHODS

=over 4

=item init

Sets up SIGWINCH handler and gets current screen size.

=cut

sub init {
        my $this=shift;

        $this->SUPER::init(@_);

        # Yeah, you need a controlling tty. Make sure there is one.
        open(TESTTY, "/dev/tty") || die gettext("This frontend requires a controlling tty.")."\n";

        $this->resize; # Get current screen size.
        $SIG{'WINCH'}=sub {
                # There is a short period during global destruction where
                # $this may have been destroyed but the handler still
                # operative.
                if (defined $this) {
                        $this->resize;
                }
        };
}

=bitem resize

This method is called whenever the tty is resized, and probes to determine the
new screen size.

=cut

sub resize {
        my $this=shift;

        if (exists $ENV{'LINES'}) {
                $this->screenheight($ENV{'LINES'});
        }
        else {
                # Gotta be a better way..
                my ($rows)=`stty -a </dev/tty 2>/dev/null` =~ m/rows (\d+)/s;
                $this->screenheight($rows || 25);
        }

        if (exists $ENV{'COLUMNS'}) {
                $this->screenwidth($ENV{'COLUMNS'});
        }
        else {
                my ($cols)=`stty -a </dev/tty 2>/dev/null` =~ m/columns (\d+)/s;
                $this->screenwidth($cols || 80);
        }
}

=back

=head1 AUTHOR

Joey Hess <joey@kitenet.net>

=cut

1
1	#!/usr/bin/perl -w
2
3	=head1 NAME
4
5	Debconf::FrontEnd::Tty - Tty FrontEnd
6
7	=cut
8
9	package Debconf::FrontEnd::Tty;
10	use strict;
11	use Debconf::Gettext;
12	use base qw(Debconf::FrontEnd);
13
14	=head1 DESCRIPTION
15
16	This FrontEnd is not useful by itself. It serves as a parent for any FrontEnds
17	that have a user interface that runs in a tty. The screenheight field is
18	always set to the current height of the tty, while the screenwidth field is
19	always set to its width.
20
21	=head1 METHODS
22
23	=over 4
24
25	=item init
26
27	Sets up SIGWINCH handler and gets current screen size.
28
29	=cut
30
31	sub init {
32	my $this=shift;
33
34	$this->SUPER::init(@_);
35
36	# Yeah, you need a controlling tty. Make sure there is one.
37	open(TESTTY, "/dev/tty") \|\| die gettext("This frontend requires a controlling tty.")."\n";
38
39	$this->resize; # Get current screen size.
40	$SIG{'WINCH'}=sub {
41	# There is a short period during global destruction where
42	# $this may have been destroyed but the handler still
43	# operative.
44	if (defined $this) {
45	$this->resize;
46	}
47	};
48	}
49
50	=bitem resize
51
52	This method is called whenever the tty is resized, and probes to determine the
53	new screen size.
54
55	=cut
56
57	sub resize {
58	my $this=shift;
59
60	if (exists $ENV{'LINES'}) {
61	$this->screenheight($ENV{'LINES'});
62	}
63	else {
64	# Gotta be a better way..
65	my ($rows)=`stty -a </dev/tty 2>/dev/null` =~ m/rows (\d+)/s;
66	$this->screenheight($rows \|\| 25);
67	}
68
69	if (exists $ENV{'COLUMNS'}) {
70	$this->screenwidth($ENV{'COLUMNS'});
71	}
72	else {
73	my ($cols)=`stty -a </dev/tty 2>/dev/null` =~ m/columns (\d+)/s;
74	$this->screenwidth($cols \|\| 80);
75	}
76	}
77
78	=back
79
80	=head1 AUTHOR
81
82	Joey Hess <joey@kitenet.net>
83
84	=cut
85
86	1