package Term::Size::Perl;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(chars pixels);
our $VERSION = '0.031';
=head1 NAME
Term::Size::Perl - Perl extension for retrieving terminal size (Perl version)
=head1 SYNOPSIS
use Term::Size::Perl;
($columns, $rows) = Term::Size::Perl::chars *STDOUT{IO};
($x, $y) = Term::Size::Perl::pixels;
=head1 DESCRIPTION
Yet another implementation of C<Term::Size>. Now
in pure Perl, with the exception of a C probe run
on build time.
=head2 FUNCTIONS
=over 4
=item B<chars>
($columns, $rows) = chars($h);
$columns = chars($h);
C<chars> returns the terminal size in units of characters
corresponding to the given filehandle C<$h>.
If the argument is omitted, C<*STDIN{IO}> is used.
In scalar context, it returns the terminal width.
=item B<pixels>
($x, $y) = pixels($h);
$x = pixels($h);
C<pixels> returns the terminal size in units of pixels
corresponding to the given filehandle C<$h>.
If the argument is omitted, C<*STDIN{IO}> is used.
In scalar context, it returns the terminal width.
Many systems with character-only terminals will return C<(0, 0)>.
=back
=head1 SEE ALSO
It all began with L<Term::Size> by Tim Goodwin. You may want to
have a look at:
L<Term::Size>
L<Term::Size::Win32>
L<Term::Size::ReadKey>
Please reports bugs via GitHub,
L<https://github.com/aferreira/cpan-Term-Size-Perl/issues>.
When reporting bugs, it may be helpful to attach the F<Params.pm> generated by
the probe at build time.
=head1 AUTHOR
Adirano Ferreira, E<lt>ferreira@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006-2007, 2017-2018 by Adriano Ferreira
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
require Term::Size::Perl::Params;
my %params = Term::Size::Perl::Params::params();
# ( row, col, x, y )
sub _winsize {
my $h = shift || *STDIN;
return unless -t $h;
my $sz = "\0" x $params{winsize}{sizeof};
ioctl($h, $params{TIOCGWINSZ}{value}, $sz)
or return;
return unpack $params{winsize}{mask}, $sz;
}
sub chars {
my @sz = _winsize(shift);
return unless @sz;
return @sz[1, 0] if wantarray;
return $sz[1];
}
sub pixels {
my @sz = _winsize(shift);
return unless @sz;
return @sz[2, 3] if wantarray;
return $sz[2];
}
1;
|