PUT results from the CPAN

App-Textcast


package App::Textcast ;

use strict;
use warnings ;
use Carp qw(carp croak confess) ;

use English qw( -no_match_vars ) ;
$OUTPUT_AUTOFLUSH++;

my $get_terminal_size ;

BEGIN
{
if($OSNAME ne 'MSWin32')
	{
	eval 'use Term::Size;' ; ## no critic (BuiltinFunctions::ProhibitStringyEval)
	croak "Error: $EVAL_ERROR" if $EVAL_ERROR;
	
	$get_terminal_size = eval ' sub { Term::Size::chars *STDOUT{IO} } ' ; ## no critic (BuiltinFunctions::ProhibitStringyEval)
	croak "Error: $EVAL_ERROR" if $EVAL_ERROR ;
	}
else
	{
	eval 'use Win32::Console;' ; ## no critic (BuiltinFunctions::ProhibitStringyEval)
	croak "Error: $EVAL_ERROR" if $EVAL_ERROR ;
	
	my $WIN32_CONSOLE = new Win32::Console;
	$get_terminal_size = eval { sub { $WIN32_CONSOLE->Size() } } ;
	croak "Error: $EVAL_ERROR" if $EVAL_ERROR ;
	}
}

BEGIN 
{
use Sub::Exporter -setup => 
	{
	exports => [ qw(record_textcast play_textcast) ],
	groups  => 
		{
		all  => [ qw() ],
		},
	};
 
use vars qw ($VERSION);
$VERSION = '0.06';
}

#-------------------------------------------------------------------------------

use Readonly ;

#~ http://www.termsys.demon.co.uk/vtansi.htm
Readonly my $CLEAR => "\e[2J" ; 
Readonly my $HOME => "\e[1;1H" ;
Readonly my $CLEAR_LINE => "\e[2K" ;
Readonly my $SAVE_CURSOR_POSITION => "\e7"  ; 
Readonly my $RESTORE_CURSOR_POSITION => "\e8"  ; 
Readonly my $HIDE_CURSOR => "\e[?25l" ;
Readonly my $SHOW_CURSOR => "\e[?25h" ;

Readonly my $EMPTY_STRING => q{} ;

use IO::Handle;
use POSIX ':sys_wait_h';
use IO::Pty;

use Term::VT102;
use File::Slurp ;

lib/App/Textcast.pm view on Meta::CPAN

=item * Size,	I did a screen cast of a completion script, the size was 1.5 MB and
	it didn't look as good as the terminal. The same textcast was 10 KB (yes,
	10 Kilo Bytes) and it looked good. 
	

=item *  It is not possible to make a screencast of a real terminal, maybe via
	vnc but that's already too complicated

=item * Documentation. I believe it is sometimes better to show "live" documentation
	than static text. I am planning to write a module that plays a textcast
	embedded in ones terminal. The text cast being controlled by the application
	that displays help. I also believe that it could be used as a complement
	to showing static logs or screenshots; an example is when someone describe
	a problem on IRC. Seeing what is being done is sometimes very helpful.

=item * Editing.
	possibility to add message
	possibility to add sound
	possibility to extend the time an image or a range of images is displayed
	concatenate text casts (and their indexes)
	remove portions of a text cast
	name part of the text cast (shows in the index)

=back

=head1 DOCUMENTATION

See L<record_textcast> and L<play_textcast> subbroutines.

=head1 SCRIPTS

Two commands, B<record_textcast> and B<play_textcast>, are installed on your computer when you install this module. Use
them to record and replay your text casts.

=head2 Output

The textcast is a serie of files recorded in a directory. Tar/gzip the files before you send them. the compression ratio averages 95%.


=head1 SUBROUTINES/METHODS

=cut

#---------------------------------------------------------------------------------------------------------
# recording
#---------------------------------------------------------------------------------------------------------

sub record_textcast
{

=head2 record_textcast( %named_arguments )

Records the terminal output of a command. The output is stored as a set of files in a directory. The
directory is later passed as argument to L<play_textcast> for display.

  use App::Textcast 'record_textcast' ;
  
  record_textcast
	(
	COMMAND => 'bash',
	OUTPUT_DIRECTORY => shift @ARGV,
	COMPRESS => $compress,
	COLUMNS => $columns,
	ROWS => $rows,
	) ;

I<Arguments>

The arguments are named, order is not important.

=over 2 

=item * COMMAND => $string - the name of the command to tun in a terminal. You most probably wan to run
I<bash> or I<sh>

=item * OUTPUT_DIRECTORY => $directory_path - Optional - the path to the directory where the textcast is to be 
recorded. This subroutine will create a directory if this option is not set. if this option is set, the directory 
should not exist.

=item * COMPRESS => $boolean - Not implemented

=item * COLUMNS => $integer - Optional - Number of columns in the terminal. The current terminal columns
number is used if this argument is not set.

=item * ROWS => $integer - Optional - Number of rows in the terminal. The current terminal rows number is
used if this argument is not set.

=back

I<Returns> - Nothing

I<Exceptions>

=over 2 

=item * See check_output_directory

=item * see create_vt102_sub_process

=item * disk full error

=back

See I<scripts/record_textcast>.

=cut

my (%arguments) = @_;

my ($terminal_columns, $terminal_rows) = $get_terminal_size->() ;

my $output_directory = check_output_directory($arguments{OUTPUT_DIRECTORY}) ;
my $vt_process = create_vt102_sub_process
				(
				$arguments{COMMAND},
				$arguments{COLUMNS} || $terminal_columns,
				$arguments{ROWS}  || $terminal_rows, 
				) ;

print $CLEAR ;
	
my $previous_time = my $start_time = [gettimeofday]  ;

my ($screenshot_index, $sub_process_ended) = (0, 0) ;

while (not $sub_process_ended) 
	{
	($sub_process_ended, my $screen_diff, my $cursor_x, my $cursor_y) = check_sub_process_output($vt_process) ;
	
	my $now = [gettimeofday] ;
	my $elapsed = tv_interval($previous_time, $now);
	$previous_time = $now ;
	
	my $screenshot_file_name = "$output_directory/$screenshot_index" ;
	
	write_file($screenshot_file_name, $screen_diff) ;
			
	my ($terminal_columns, $terminal_rows) = $get_terminal_size->() ;
		
	append_file 
		(
		"$output_directory/index",
		
		'{'
		. "file => $screenshot_index, "
		. sprintf('delay => %0.3f, ', $elapsed)
		. "cursor_x => $cursor_x, "
		. "cursor_y => $cursor_y, "
		. 'size => ' . length($screen_diff) . ', '
		. "terminal_rows => $terminal_rows, "
		. "terminal_columns => $terminal_columns, "
		. "},\n" 
		) ;
			
	$screenshot_index++ ;
	}

my $record_time = tv_interval($start_time, [gettimeofday]);
printf("record_textcast: $screenshot_index frames in %.02f seconds. Textcast is in '$output_directory'.\r\n", $record_time) ;

close_vt102_sub_process($vt_process) ;

return ;
}

#---------------------------------------------------------------------------------------------------------

sub check_output_directory
{

=head2 [p] check_output_directory( $output_directory)

lib/App/Textcast.pm view on Meta::CPAN


#---------------------------------------------------------------------------------------------------------

sub close_vt102_sub_process
{

=head2 [p] close_vt102_sub_process( $vt_process)

I<Arguments>

=over 2 

=item * $vt_process -  vt_process handle created by L<create_vt102_sub_process>

=back

I<Returns> - Nothing

I<Exceptions> - None

=cut

my ($vt_process) = @_ ;
$vt_process->{PTY}->close;

# Reset the terminal parameters.
system 'stty sane';

return ;
}

#---------------------------------------------------------------------------------------------------------

sub create_vt102_terminal
{

=head2 [p] create_vt102_terminal($pty, $columns, $rows)

I<Arguments>

=over 2 

=item $pty, $columns, $rows - 

=back

I<Returns> - $vt, $terminal_change_buffer 

I<Exceptions> - None

=cut

my ($pty, $columns, $rows) = @_ ;

my $terminal_change_buffer = {};
my $vt = Term::VT102->new (cols => $columns, rows => $rows,);

$vt->option_set ('LFTOCRLF', 1); # Convert linefeeds to linefeed + carriage return.
$vt->option_set ('LINEWRAP', 1); # Make sure line wrapping is switched on.

# Set up the callback for OUTPUT; this callback function simply sends
# whatever the Term::VT102 module wants to send back to the terminal and
# sends it to the child process - see its definition below.
$vt->callback_set ('OUTPUT', \&vt_output, $pty);

# Set up a callback for row changes, so we can process updates and display
# them without having to redraw the whole screen every time. We catch CLEAR,
# SCROLL_UP, and SCROLL_DOWN with another function that triggers a
# whole-screen repaint. You could process SCROLL_UP and SCROLL_DOWN more
# elegantly, but this is just an example.
$vt->callback_set ('ROWCHANGE', \&vt_rowchange, $terminal_change_buffer );
$vt->callback_set ('CLEAR', \&vt_changeall, $terminal_change_buffer );
$vt->callback_set ('SCROLL_UP', \&vt_changeall, $terminal_change_buffer );
$vt->callback_set ('SCROLL_DOWN', \&vt_changeall, $terminal_change_buffer );

# Set stdin's terminal to raw mode so we can pass all keypresses straight
# through immediately.
system 'stty raw -echo';

return ($vt, $terminal_change_buffer ) ;
}

#---------------------------------------------------------------------------------------------------------

sub vt_output 
{

=head2 [p] vt_output($vtobject, $type, $arg1, $arg2, $private)

Callback for OUTPUT events - for Term::VT102.

I<Arguments>

=over 2 

=item $vtobject, $type, $arg1, $arg2, $private - 

=back

I<Returns> - Nothing

I<Exceptions> - Nothing

See L<Term::VT102>.

=cut

my ($vtobject, $type, $arg1, $arg2, $private) = @_;

if ($type eq 'OUTPUT') 
	{
	$private->syswrite ($arg1, length $arg1);
	}

return ;
}

#---------------------------------------------------------------------------------------------------------

sub vt_rowchange 
{

=head2 [p] vt_rowchange($vtobject, $type, $arg1, $arg2, $private)

Callback for ROWCHANGE events. This just sets a time value for the changed
row using the private data as a hash reference - the time represents the
earliest that row was changed since the last screen update.

I<Arguments>

=over 2 

=item $vtobject, $type, $arg1, $arg2, $private - 

=back

I<Returns> - Nothing

I<Exceptions> - Nothing

See L<Term::VT102>.

=cut

my ($vtobject, $type, $arg1, $arg2, $private) = @_;
$private->{$arg1} = time if (not exists $private->{$arg1});

return ;
}

#---------------------------------------------------------------------------------------------------------

sub vt_changeall 
{

=head2 [p] vt_changeall($vtobject, $type, $arg1, $arg2, $private)

Callback to trigger a full-screen repaint.

I<Arguments>

=over 2 

=item $vtobject, $type, $arg1, $arg2, $private - 

=back

I<Returns> - Nothing

I<Exceptions> - None

( run in 0.736 second using v1.01-cache-2.11-cpan-13bb782fe5a )