From 508218365c734253b7a0855084031be28446de66 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 15 Jun 2010 21:20:26 -0500 Subject: dzil stuff --- .gitignore | 5 +++ Changes | 60 ++++++++++++++++++----------------- dist.ini | 5 ++- lib/App/Termcast.pm | 80 +++++++---------------------------------------- t/000-load.t | 8 ----- t/001-basic.t | 41 ------------------------ t/002-read-write.t | 55 -------------------------------- t/003-write-to-termcast.t | 37 ---------------------- t/01-basic.t | 41 ++++++++++++++++++++++++ t/02-read-write.t | 55 ++++++++++++++++++++++++++++++++ t/03-write-to-termcast.t | 37 ++++++++++++++++++++++ weaver.ini | 36 +++++++++++++++++++++ 12 files changed, 219 insertions(+), 241 deletions(-) delete mode 100644 t/000-load.t delete mode 100644 t/001-basic.t delete mode 100644 t/002-read-write.t delete mode 100644 t/003-write-to-termcast.t create mode 100644 t/01-basic.t create mode 100644 t/02-read-write.t create mode 100644 t/03-write-to-termcast.t create mode 100644 weaver.ini diff --git a/.gitignore b/.gitignore index bfd20cf..dd4a425 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,8 @@ inc pm_to_blib MANIFEST Makefile.old +nytprof.out +MANIFEST.bak +*.sw[po] +.build +App-Termcast-* diff --git a/Changes b/Changes index a5ea511..7aafbfa 100644 --- a/Changes +++ b/Changes @@ -1,43 +1,45 @@ -Revision history for App::Termcast +Revision history for App-Termcast -0.07 06/15/2010 - Refactor the establishment message (the first line sent to the - termcast server) to its own attribute (jasonmay) +{{$NEXT}} + - Refactor the establishment message (the first line sent to the termcast + server) to its own attribute (jasonmay) -0.06 04/19/2010 - Fix reconnecting (was using wrong method name) + - Convert to more dzil stuff -0.05 04/18/2010 - Fix the default termcast server (how did that get changed?) +0.06 2010-04-19 + - Fix reconnecting (was using wrong method name) -0.04 04/18/2010 - Stop ending the session when there is an error while writing to the - termcast server +0.05 2010-04-18 + - Fix the default termcast server (how did that get changed?) - Refactor the code a bit to allow sending arbitrary data to the termcast - server without requiring an interactive session +0.04 2010-04-18 + - Stop ending the session when there is an error while writing to the + termcast server - Add a script to stream a ttyrec file to the termcast server + - Refactor the code a bit to allow sending arbitrary data to the termcast + server without requiring an interactive session - The command for the run method to run is now required to be passed to the - run method, rather than figuring it out from ARGV directly + - Add a script to stream a ttyrec file to the termcast server -0.03 03/27/2010 - Reconnect to the termcast server if the connection is interrupted + - The command for the run method to run is now required to be passed to + the run method, rather than figuring it out from ARGV directly -0.02 09/27/2009 - Add new option --bell-on-watcher to send a bell to your terminal whenever - a watcher connects +0.03 2010-03-27 + - Reconnect to the termcast server if the connection is interrupted - Stop dying when the terminal is resized +0.02 2009-09-27 + - Add new option --bell-on-watcher to send a bell to your terminal + whenever a watcher connects - Use Scope::Guard to better clean up ReadMode when we're done + - Stop dying when the terminal is resized -0.01 07/11/2009 - A few more bug fixes, and actual tests + - Use Scope::Guard to better clean up ReadMode when we're done -0.01_02 07/10/2009 - A few bug fixes +0.01 2009-07-11 + - A few more bug fixes, and actual tests -0.01_01 07/10/2009 - Initial release +0.01_02 2009-07-10 + - A few bug fixes + +0.01_01 2009-07-10 + - Initial release diff --git a/dist.ini b/dist.ini index 47e796b..2911988 100644 --- a/dist.ini +++ b/dist.ini @@ -1,11 +1,10 @@ name = App-Termcast -version = 0.06 author = Jesse Luehrs license = Perl_5 copyright_holder = Jesse Luehrs -abstract = broadcast your terminal sessions for remote viewing -[@Classic] +[@DOY] +dist = App-Termcast [Prereq] Moose = 0 diff --git a/lib/App/Termcast.pm b/lib/App/Termcast.pm index 4b51398..dc9a6c0 100644 --- a/lib/App/Termcast.pm +++ b/lib/App/Termcast.pm @@ -1,14 +1,13 @@ package App::Termcast; use Moose; +# ABSTRACT: broadcast your terminal sessions for remote viewing + +with 'MooseX::Getopt::Dashes'; + use IO::Pty::Easy; use IO::Socket::INET; use Scope::Guard; use Term::ReadKey; -with 'MooseX::Getopt::Dashes'; - -=head1 NAME - -App::Termcast - broadcast your terminal sessions for remote viewing =head1 SYNOPSIS @@ -22,11 +21,7 @@ broadcasting of a terminal session for remote viewing. =cut -=head1 ATTRIBUTES - -=cut - -=head2 host +=attr host Server to connect to (defaults to noway.ratry.ru, the host for the termcast.org service). @@ -40,7 +35,7 @@ has host => ( documentation => 'Hostname of the termcast server to connect to', ); -=head2 port +=attr port Port to use on the termcast server (defaults to 31337). @@ -53,7 +48,7 @@ has port => ( documentation => 'Port to connect to on the termcast server', ); -=head2 user +=attr user Username to use (defaults to the local username). @@ -66,7 +61,7 @@ has user => ( documentation => 'Username for the termcast server', ); -=head2 password +=attr password Password for the given user. The password is set the first time that username connects, and must be the same every subsequent time. It is sent in plaintext @@ -84,7 +79,7 @@ has password => ( . " (mostly unimportant)", ); -=head2 bell_on_watcher +=attr bell_on_watcher Whether or not to send a bell to the terminal when a watcher connects or disconnects. Defaults to false. @@ -99,7 +94,7 @@ has bell_on_watcher => ( . " or disconnects", ); -=head2 timeout +=attr timeout How long in seconds to use for the timeout to the termcast server. Defaults to 5. @@ -205,11 +200,7 @@ sub _in_ready { vec($vec, fileno(STDIN), 1); } -=head1 METHODS - -=cut - -=head2 write_to_termcast $BUF +=method write_to_termcast $BUF Sends C<$BUF> to the termcast server. @@ -230,7 +221,7 @@ sub write_to_termcast { $self->socket->syswrite($buf); } -=head2 run @ARGV +=method run @ARGV Runs the given command in the local terminal as though via C, but streams all output from that command to the termcast server. The command may be an @@ -318,57 +309,10 @@ no Moose; Use L to make configuration easier. -=head1 BUGS - -No known bugs. - -Please report any bugs through RT: email -C, or browse to -L. - =head1 SEE ALSO L -=head1 SUPPORT - -You can find this documentation for this module with the perldoc command. - - perldoc App::Termcast - -You can also look for information at: - -=over 4 - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * RT: CPAN's request tracker - -L - -=item * Search CPAN - -L - -=back - -=head1 AUTHOR - - Jesse Luehrs - -=head1 COPYRIGHT AND LICENSE - -This software is copyright (c) 2009-2010 by Jesse Luehrs. - -This is free software; you can redistribute it and/or modify it under -the same terms as perl itself. - =cut 1; diff --git a/t/000-load.t b/t/000-load.t deleted file mode 100644 index 3561825..0000000 --- a/t/000-load.t +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 1; - -package Foo; -::use_ok('App::Termcast') - or ::BAIL_OUT("couldn't load App::Termcast"); diff --git a/t/001-basic.t b/t/001-basic.t deleted file mode 100644 index 7dd9a7e..0000000 --- a/t/001-basic.t +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use App::Termcast; -use IO::Pty::Easy; -BEGIN { - eval "use Test::TCP;"; - plan skip_all => "Test::TCP is required for this test" if $@; - plan tests => 3; -} - -test_tcp( - client => sub { - my $port = shift; - my $client_script = <new(host => '127.0.0.1', port => $port, - user => 'test', password => 'tset'); - \$tc->run('$^X', "-e", "print 'foo'"); -EOF - my $pty = IO::Pty::Easy->new; - $pty->spawn("$^X", "-e", $client_script); - is($pty->read, 'foo', 'got the right thing on stdout'); - sleep 1; # because the server gets killed when the client exits - }, - server => sub { - my $port = shift; - my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', - LocalPort => $port, - Listen => 1); - $sock->accept; # signal to the client that the port is available - my $client = $sock->accept; - my $login; - $client->recv($login, 4096); - is($login, "hello test tset\n", 'got the correct login info'); - my $output; - $client->recv($output, 4096); - is($output, "foo", 'sent the right data to the server'); - }, -); diff --git a/t/002-read-write.t b/t/002-read-write.t deleted file mode 100644 index a03effb..0000000 --- a/t/002-read-write.t +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use App::Termcast; -use IO::Pty::Easy; -BEGIN { - eval "use Test::TCP;"; - plan skip_all => "Test::TCP is required for this test" if $@; - plan tests => 5; -} - -test_tcp( - client => sub { - my $port = shift; - my $client_script = <new( - host => '127.0.0.1', port => $port, - user => 'test', password => 'tset'); - \$tc->run('$^X', "-e", "while (<>) { last if /\\\\./; print }"); -EOF - my $pty = IO::Pty::Easy->new; - $pty->spawn("$^X", "-e", $client_script); - $pty->write("foo\n"); - sleep 1; # give the subprocess time to generate its output - is($pty->read, "foo\r\nfoo\r\n", 'got the right thing on stdout'); - $pty->write("bar\n"); - sleep 1; # give the subprocess time to generate its output - is($pty->read, "bar\r\nbar\r\n", 'got the right thing on stdout'); - $pty->write(".\n"); - is($pty->read, ".\r\n", "didn't get too much data"); - sleep 1; # because the server gets killed when the client exits - }, - server => sub { - my $port = shift; - my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', - LocalPort => $port, - Listen => 1); - $sock->accept; # signal to the client that the port is available - my $client = $sock->accept; - my $login; - $client->recv($login, 4096); - is($login, "hello test tset\n", 'got the correct login info'); - my $output; - my $total_out = ''; - while (1) { - $client->recv($output, 4096); - last unless defined($output) && length($output); - $total_out .= $output; - } - is($total_out, "foo\r\nfoo\r\nbar\r\nbar\r\n.\r\n", - 'sent the right data to the server'); - }, -); diff --git a/t/003-write-to-termcast.t b/t/003-write-to-termcast.t deleted file mode 100644 index 04045cf..0000000 --- a/t/003-write-to-termcast.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use App::Termcast; -BEGIN { - eval "use Test::TCP;"; - plan skip_all => "Test::TCP is required for this test" if $@; - plan tests => 3; -} - -test_tcp( - client => sub { - my $port = shift; - my $tc = App::Termcast->new( - host => '127.0.0.1', port => $port, - user => 'test', password => 'tset'); - $tc->write_to_termcast('foo'); - ok(!$tc->meta->find_attribute_by_name('pty')->has_value($tc), - "pty isn't created"); - sleep 1; - }, - server => sub { - my $port = shift; - my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', - LocalPort => $port, - Listen => 1); - $sock->accept; # signal to the client that the port is available - my $client = $sock->accept; - my $login; - $client->recv($login, 4096); - is($login, "hello test tset\n", 'got the correct login info'); - my $buf; - $client->recv($buf, 4096); - is($buf, 'foo', 'wrote correctly'); - }, -); diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100644 index 0000000..7dd9a7e --- /dev/null +++ b/t/01-basic.t @@ -0,0 +1,41 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use App::Termcast; +use IO::Pty::Easy; +BEGIN { + eval "use Test::TCP;"; + plan skip_all => "Test::TCP is required for this test" if $@; + plan tests => 3; +} + +test_tcp( + client => sub { + my $port = shift; + my $client_script = <new(host => '127.0.0.1', port => $port, + user => 'test', password => 'tset'); + \$tc->run('$^X', "-e", "print 'foo'"); +EOF + my $pty = IO::Pty::Easy->new; + $pty->spawn("$^X", "-e", $client_script); + is($pty->read, 'foo', 'got the right thing on stdout'); + sleep 1; # because the server gets killed when the client exits + }, + server => sub { + my $port = shift; + my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', + LocalPort => $port, + Listen => 1); + $sock->accept; # signal to the client that the port is available + my $client = $sock->accept; + my $login; + $client->recv($login, 4096); + is($login, "hello test tset\n", 'got the correct login info'); + my $output; + $client->recv($output, 4096); + is($output, "foo", 'sent the right data to the server'); + }, +); diff --git a/t/02-read-write.t b/t/02-read-write.t new file mode 100644 index 0000000..a03effb --- /dev/null +++ b/t/02-read-write.t @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use App::Termcast; +use IO::Pty::Easy; +BEGIN { + eval "use Test::TCP;"; + plan skip_all => "Test::TCP is required for this test" if $@; + plan tests => 5; +} + +test_tcp( + client => sub { + my $port = shift; + my $client_script = <new( + host => '127.0.0.1', port => $port, + user => 'test', password => 'tset'); + \$tc->run('$^X', "-e", "while (<>) { last if /\\\\./; print }"); +EOF + my $pty = IO::Pty::Easy->new; + $pty->spawn("$^X", "-e", $client_script); + $pty->write("foo\n"); + sleep 1; # give the subprocess time to generate its output + is($pty->read, "foo\r\nfoo\r\n", 'got the right thing on stdout'); + $pty->write("bar\n"); + sleep 1; # give the subprocess time to generate its output + is($pty->read, "bar\r\nbar\r\n", 'got the right thing on stdout'); + $pty->write(".\n"); + is($pty->read, ".\r\n", "didn't get too much data"); + sleep 1; # because the server gets killed when the client exits + }, + server => sub { + my $port = shift; + my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', + LocalPort => $port, + Listen => 1); + $sock->accept; # signal to the client that the port is available + my $client = $sock->accept; + my $login; + $client->recv($login, 4096); + is($login, "hello test tset\n", 'got the correct login info'); + my $output; + my $total_out = ''; + while (1) { + $client->recv($output, 4096); + last unless defined($output) && length($output); + $total_out .= $output; + } + is($total_out, "foo\r\nfoo\r\nbar\r\nbar\r\n.\r\n", + 'sent the right data to the server'); + }, +); diff --git a/t/03-write-to-termcast.t b/t/03-write-to-termcast.t new file mode 100644 index 0000000..04045cf --- /dev/null +++ b/t/03-write-to-termcast.t @@ -0,0 +1,37 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use App::Termcast; +BEGIN { + eval "use Test::TCP;"; + plan skip_all => "Test::TCP is required for this test" if $@; + plan tests => 3; +} + +test_tcp( + client => sub { + my $port = shift; + my $tc = App::Termcast->new( + host => '127.0.0.1', port => $port, + user => 'test', password => 'tset'); + $tc->write_to_termcast('foo'); + ok(!$tc->meta->find_attribute_by_name('pty')->has_value($tc), + "pty isn't created"); + sleep 1; + }, + server => sub { + my $port = shift; + my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', + LocalPort => $port, + Listen => 1); + $sock->accept; # signal to the client that the port is available + my $client = $sock->accept; + my $login; + $client->recv($login, 4096); + is($login, "hello test tset\n", 'got the correct login info'); + my $buf; + $client->recv($buf, 4096); + is($buf, 'foo', 'wrote correctly'); + }, +); diff --git a/weaver.ini b/weaver.ini new file mode 100644 index 0000000..219a165 --- /dev/null +++ b/weaver.ini @@ -0,0 +1,36 @@ +[@CorePrep] + +[Name] +[Version] + +[Region / prelude] + +[Generic / SYNOPSIS] +[Generic / DESCRIPTION] +[Generic / OVERVIEW] + +[Collect / ATTRIBUTES] +command = attr + +[Collect / METHODS] +command = method + +[Collect / FUNCTIONS] +command = func + +[Leftovers] + +[Region / postlude] + +[Template / BUGS] +template = ~/.dzil/pod_templates/bugs.section +main_module_only = 1 + +[SeeAlso] + +[Template / SUPPORT] +template = ~/.dzil/pod_templates/support.section +main_module_only = 1 + +[Authors] +[Legal] -- cgit v1.2.3-54-g00ecf