Term-Size-Perl-0.029/0000755000175200010010000000000010575102774013462 5ustar FerreiraNoneTerm-Size-Perl-0.029/t/0000755000175200010010000000000010575102774013725 5ustar FerreiraNoneTerm-Size-Perl-0.029/t/99_pod.t0000644000175200010010000000022510507203252015200 0ustar FerreiraNone use Test::More; eval "use Test::Pod 1.18"; plan skip_all => "Test::Pod 1.18 required for testing POD" if $@; all_pod_files_ok(all_pod_files(".")); Term-Size-Perl-0.029/t/01_basic.t0000644000175200010010000000222310575100304015455 0ustar FerreiraNone use Test::More tests => 17; #use Test::More no_plan => 1; BEGIN { use_ok('Term::Size::Perl'); } my @handles = ( # name args handle [ 'implicit STDIN', [], *STDIN ], # default: implicit STDIN [ 'STDIN', [*STDIN], *STDIN ], [ 'STDERR', [*STDERR], *STDERR ], [ 'STDOUT', [*STDOUT], *STDOUT ], ); for (@handles) { my $h_name = $_->[0]; my @args = @{$_->[1]}; my $h = $_->[2]; SKIP: { skip "$h_name is not tty", 4 unless -t $h; my @chars = Term::Size::Perl::chars @args; is(scalar @chars, 2, "$h_name: chars return (cols, rows) - $h_name"); my $cols = Term::Size::Perl::chars @args; is($cols, $chars[0], "$h_name: chars return cols"); my @pixels = Term::Size::Perl::pixels @args; is(scalar @pixels, 2, "$h_name: pixels return (x, y)"); my $x = Term::Size::Perl::pixels @args; is($x, $pixels[0], "$h_name: pixels return x"); } } if (-t STDIN) { # this is not at test, only a show-off my @chars = Term::Size::Perl::chars; my @pixels = Term::Size::Perl::pixels; diag("This terminal is $chars[0]x$chars[1] characters,"), diag(" and $pixels[0]x$pixels[1] pixels."); } Term-Size-Perl-0.029/t/98_pod-coverage.t0000644000175200010010000000024310507203252016770 0ustar FerreiraNone use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok();Term-Size-Perl-0.029/t/00_use.t0000644000175200010010000000022110507203252015164 0ustar FerreiraNone use Test::More tests => 1; BEGIN { use_ok('Term::Size::Perl'); } diag( "Testing Term::Size::Perl $Term::Size::Perl::VERSION, Perl $], $^X" ); Term-Size-Perl-0.029/Changes0000644000175200010010000000122110575100450014736 0ustar FerreiraNoneRevision history for Perl extension Term-Size-Perl. 0.029 Tue Mar 11 2007 - major rewrite of t/01_basic.t * added SKIP if tested globs are not tty * removed wrong assumption that STDIN would always match STDERR * test implicit argument, *STDIN, *STDERR e *STDOUT - tuned the answers for non-tty arguments: tests are still missing 0.0201 Tue Nov 7 2006 - section BUGS on Perl.pm - no code changes 0.02 Wed Jun 14 2006 - use strict - tweaked POD - introduced a POD coverage test 0.01 Mon May 29 2006 - first release to CPAN Term-Size-Perl-0.029/Perl.pm0000644000175200010010000000575410575102544014730 0ustar FerreiraNone package Term::Size::Perl; use strict; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(chars pixels); our $VERSION = 0.029; =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. Now in pure Perl, with the exception of a C probe run on build time. =head2 FUNCTIONS =over 4 =item B ($columns, $rows) = chars($h); $columns = chars($h); C returns the terminal size in units of characters corresponding to the given filehandle C<$h>. If the argument is ommitted, C<*STDIN{IO}> is used. In scalar context, it returns the terminal width. =item B ($x, $y) = pixels($h); $x = pixels($h); C returns the terminal size in units of pixels corresponding to the given filehandle C<$h>. If the argument is ommitted, 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 by Tim Goodwin. You may want to have a look at: Term::Size Term::Size::Unix Term::Size::Win32 Term::Size::ReadKey It would be helpful if you send me the F generated by the probe at build time. Please reports bugs via CPAN RT, http://rt.cpan.org/NoAuth/Bugs.html?Dist=Term-Size-Perl =head1 BUGS I am having some hard time to make tests run correctly under the C script. Some Unix systems do not seem to provide a working tty inside automatic installers. I think it needs some skip tests, but I am yet not sure what should be the portable tests for this. Update: This distribution uses new tests to skip if filehandle is not a tty. It was noticed that C and C, for instance, provide a non-tty STDOUT to the test script and automatic installers could provide a non-tty STDIN. So the former tests were basically wrong. I am improving my understanding of the involved issues and I hope to soon fix the tests for all of Term::Size modules. =head1 AUTHOR A. R. Ferreira, Eferreira@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2007 by A. R. 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; Term-Size-Perl-0.029/MANIFEST0000644000175200010010000000044410575102776014617 0ustar FerreiraNoneinc/Probe.pm Makefile.PL MANIFEST This list of files README Changes #Params.pm Generated by inc/Probe.pm Perl.pm t/00_use.t t/01_basic.t t/98_pod-coverage.t t/99_pod.t META.yml Module meta-data (added by MakeMaker) Term-Size-Perl-0.029/inc/0000755000175200010010000000000010575102774014233 5ustar FerreiraNoneTerm-Size-Perl-0.029/inc/Probe.pm0000644000175200010010000001607610507203252015636 0ustar FerreiraNone package Probe; =head1 NAME inc/Probe.pm - Probes some machine configuration parameters for Term::Size::Perl's sake =head1 SYNOPSIS $ perl 'inc/Probe.pm'; =head1 DESCRIPTION TODO: improve error handling - this failed horribly in Windows with ExtUtils::CBuilder Probe.pm * writes a C file * builds it (ExtUtils::CBuilder) * runs it (backquote) * grabs the output and creates Term/Size/Perl/Params.pm Yes, that's Perl code which writes C code which writes Perl code. a typical declaration (found somewhere along "termios.h") /* Interface to get and set terminal size. */ struct winsize { unsigned short ws_row; /* Rows, in characters */ unsigned short ws_col; /* Columns, in characters */ unsigned short ws_xpixel; /* Horizontal size, pixels */ unsigned short ws_ypixel; /* Vertical size, pixels */ }; ASSUMPTIONS SO FAR: =over 4 =item * struct winsize has no alignment pad (because we'll be using C and relying on this arrangement) =item * the fields follow the order: ws_row, ws_col, ws_xpixel, ws_ypixel (because we'll be using C and relying on this order) =item * the type of each field is native unsigned short (because we'll be using C with S! field) =back WHAT WE ARE PROBING =over 4 =item * sizeof(struct winsize) =item * TIOCGWINSZ =item * the definition of TIOCGWINSZ =back WHAT THE OUTPUT LOOKS LIKE package Term::Size::Perl::Params; sub params { return ( winsize => { sizeof => 8, mask => 'S!S!S!S!' }, TIOCGWINSZ => { value => 21505, definition => qq{(('T' << 8) | 1)} } ); } 1; =head2 FUNCTIONS =over 4 =cut use ExtUtils::MakeMaker; # MM->parse_version($file) # ATTENTION: $ and @ (if any) should be escaped (to survive interpolation) # ATTENTION: % should be doubled (to pass through Perl sprintf) # ATTENTION: POD directives are escaped so that Test::Pod don't say bad things about my POD my $PARAMS_TEMPLATE = <parse_version('Perl.pm')]}; \=head1 Term::Size::Perl::Params \=head2 params \$href = Term::Size::Perl::Params The configuration parameters C needs to know for retrieving the terminal size with C. \=cut sub params { return ( winsize => { sizeof => %%.f, mask => 'S!S!S!S!' }, TIOCGWINSZ => { value => %%.f, definition => qq{%%s} } ); } 1; PARAMS sub _quote_chunk { my $string = shift; return map { qq{"$_\\n"\n} } split "\n", $string; } my $PROBE_TEMPLATE = sprintf < #include #include #define xstr(s) str(s) #define str(s) #s int main(int argc, char *argv[]) { printf( @{[_quote_chunk $PARAMS_TEMPLATE]}, (double)sizeof(struct winsize), (double)TIOCGWINSZ, xstr(TIOCGWINSZ)); return 0; } PROBE sub _print_s { print __FILE__, ": ", @_ } sub _print_ok { print((shift() ? 'ok' : 'NO'), "\n") }; sub _warn_s { print __FILE__, ": ", @_ } sub _write_file { my $contents = shift; my $fn = shift; local (*FH, $!); open FH, "> $fn" or _warn_s("can't create '$fn': $!\n"), return undef; print FH $contents; _warn_s("error writing to '$fn': $!\n") if $!; close FH or _warn_s("error closing '$fn': $!\n"); return 1 } =item write_probe $c_file = write_probe($c_file); Writes the source code of the probe to the file C<$c_file>. Returns C<$c_file> if successful. Returns C if something bad happened while writing the file. =cut sub write_probe { my $c_file = shift; my $ok; _print_s("writing C probe... "); $ok = _write_file($PROBE_TEMPLATE, $c_file); _print_ok($ok); return undef unless $ok; return $c_file; } =item build_probe $exe_file = build_probe($c_file); Compiles the C source C<$c_file> to object and then links it to an executable file. Returns the executable file name. If successful, it deletes the intermediary object file. If compiling or linking fails, returns undef. =cut # if you want to suppress compiler/linker output: ( quiet => 1 ) my %options = ( quiet => 0 ); sub build_probe { my $c_file = shift; require ExtUtils::CBuilder; my $builder = ExtUtils::CBuilder->new(%options); _print_s("compiling C probe... "); my $obj_file = eval { $builder->compile(source => $c_file) }; # don't die (now) _print_ok($obj_file); return undef unless $obj_file; _print_s("linking C probe... "); my $exe_file = eval { $builder->link_executable(objects => $obj_file) }; # don't die (now) _print_ok($exe_file); return undef unless $exe_file; unlink $obj_file or _warn_s $!; return $exe_file; } =item run_probe $output = run_probe($exe_file); Runs the executable file C<$exe_file>, captures its output to STDOUT and returns it. Returns C if the exit code (C<$?>) is not 0. =cut sub run_probe { my $exe_file = shift; _print_s("running C probe... "); my $output = `./$exe_file`; _print_ok(!$?); return undef if $?; return $output; } =item write_params $out_file = write_params($pl_code, $out_file); Writes the contents of C<$pl_code> (a scalar supposed to contain the Perl code of the information we were after) to file C<$out_file>. Returns C<$out_file> if successful. Returns C if something bad happened while writing the file. =cut sub write_params { my $pl_code = shift; my $out_file = shift; _print_s("writing '$out_file'... "); my $ok = _write_file($pl_code, $out_file); _print_ok($ok); return undef unless $ok; return $out_file; } =item run run() Runs the probe. First, it writes a C file named F. Second, it compiles and links this source. Then, the resulting executable is run and its output captured. At last, this output get written to the file F. (The intermediary files - F, object and executable files - are deleted at the end of a successful run.) If successful, returns 0. Otherwise, returns true. =cut sub run { my ($c_file, $exe_file, $out_file); $c_file = write_probe('probe.c') or return 1; # FAIL $exe_file = build_probe($c_file) or return 1; # FAIL $out_file = run_probe($exe_file) or return 1; # FAIL write_params($out_file, 'Params.pm') or return 1; # FAIL # clean unlink $c_file or _warn_s $!; unlink $exe_file or _warn_s $!; return 0; # SUCCESS } =pod =back =head1 SEE ALSO L =head1 AUTHOR A. R. Ferreira, Eferreira@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006 by A. R. Ferreira This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut package main; my $exit = Probe::run(); exit($exit); Term-Size-Perl-0.029/Makefile.PL0000644000175200010010000000203310575101256015424 0ustar FerreiraNone use 5; use ExtUtils::MakeMaker; my $EUMM_VERSION = eval $ExtUtils::MakeMaker::VERSION; # a target to run the probe (which generates Params.pm) sub MY::postamble { return <<'MAKE_FRAG'; Params.pm: inc/Probe.pm $(PERL) inc/Probe.pm MAKE_FRAG } WriteMakefile( NAME => 'Term::Size::Perl', VERSION_FROM => 'Perl.pm', ($] >= 5.005 ? ( 'ABSTRACT_FROM' => 'Perl.pm', 'AUTHOR' => 'Adriano R. Ferreira ' ) : ()), ($EUMM_VERSION >= 6.31 ? ( LICENSE => 'perl', # EXTRA_META => "no_index:\n file:\n - inc/Probe.pm\n" # EXTRA_META => { recommends => { 'ExtUtils::Manifest' => 1.50 } }, ) :()), PREREQ_PM => { Exporter => 0, ExtUtils::CBuilder => 0, # build Test::More => 0, # build }, PM => { 'Perl.pm' => '$(INST_LIBDIR)/Perl.pm', 'Params.pm' => '$(INST_LIBDIR)/Perl/Params.pm' }, clean => { FILES => "Params.pm" }, ); Term-Size-Perl-0.029/README0000644000175200010010000000101410507203252014322 0ustar FerreiraNoneThis is alpha release 0.02 of Term::Size::Perl. Term::Size::Perl is a Perl module which provides a straightforward way to get the size of the terminal (or window) on which a script is running. After building/installing, this module does it job with pure Perl code, via ioctl() builtin. The trick is to extract at build time some configuration parameters via compiling/running a C code which gets the needed information for driving Perl ioctl() in the specific machine. Adriano Ferreira Jun 14 2006 Term-Size-Perl-0.029/META.yml0000644000175200010010000000103610575102776014735 0ustar FerreiraNone--- #YAML:1.0 name: Term-Size-Perl version: 0.029 abstract: Perl extension for retrieving terminal size (Perl version) license: perl generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: Exporter: 0 ExtUtils::CBuilder: 0 Test::More: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 author: - Adriano R. Ferreira