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