1
2package Term::Size::Perl;
3
4use strict;
5
6require Exporter;
7
8our @ISA = qw(Exporter);
9our @EXPORT_OK = qw(chars pixels);
10
11our $VERSION = '0.031';
12
13=head1 NAME
14
15Term::Size::Perl - Perl extension for retrieving terminal size (Perl version)
16
17=head1 SYNOPSIS
18
19    use Term::Size::Perl;
20
21    ($columns, $rows) = Term::Size::Perl::chars *STDOUT{IO};
22    ($x, $y) = Term::Size::Perl::pixels;
23
24=head1 DESCRIPTION
25
26Yet another implementation of C<Term::Size>. Now
27in pure Perl, with the exception of a C probe run
28on build time.
29
30=head2 FUNCTIONS
31
32=over 4
33
34=item B<chars>
35
36    ($columns, $rows) = chars($h);
37    $columns = chars($h);
38
39C<chars> returns the terminal size in units of characters
40corresponding to the given filehandle C<$h>.
41If the argument is omitted, C<*STDIN{IO}> is used.
42In scalar context, it returns the terminal width.
43
44=item B<pixels>
45
46    ($x, $y) = pixels($h);
47    $x = pixels($h);
48
49C<pixels> returns the terminal size in units of pixels
50corresponding to the given filehandle C<$h>.
51If the argument is omitted, C<*STDIN{IO}> is used.
52In scalar context, it returns the terminal width.
53
54Many systems with character-only terminals will return C<(0, 0)>.
55
56=back
57
58=head1 SEE ALSO
59
60It all began with L<Term::Size> by Tim Goodwin. You may want to
61have a look at:
62
63L<Term::Size>
64
65L<Term::Size::Win32>
66
67L<Term::Size::ReadKey>
68
69Please reports bugs via GitHub,
70L<https://github.com/aferreira/cpan-Term-Size-Perl/issues>.
71When reporting bugs, it may be helpful to attach the F<Params.pm> generated by
72the probe at build time.
73
74=head1 AUTHOR
75
76Adirano Ferreira, E<lt>ferreira@cpan.orgE<gt>
77
78=head1 COPYRIGHT AND LICENSE
79
80Copyright (C) 2006-2007, 2017-2018 by Adriano Ferreira
81
82This library is free software; you can redistribute it and/or modify
83it under the same terms as Perl itself.
84
85=cut
86
87require Term::Size::Perl::Params;
88my %params = Term::Size::Perl::Params::params();
89
90# ( row, col, x, y )
91sub _winsize {
92    my $h = shift || *STDIN;
93    return unless -t $h;
94    my $sz = "\0" x $params{winsize}{sizeof};
95    ioctl($h, $params{TIOCGWINSZ}{value}, $sz)
96        or return;
97    return unpack $params{winsize}{mask}, $sz;
98}
99
100sub chars {
101    my @sz = _winsize(shift);
102    return unless @sz;
103    return @sz[1, 0] if wantarray;
104    return $sz[1];
105}
106
107sub pixels {
108    my @sz = _winsize(shift);
109    return unless @sz;
110    return @sz[2, 3] if wantarray;
111    return $sz[2];
112}
113
1141;
115