App-Textcast

 view release on metacpan or  search on metacpan

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

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;
	

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

=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.

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

=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]  ;

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

=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 );

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

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 

scripts/record_textcast  view on Meta::CPAN

use Getopt::Long ;
use App::Textcast 'record_textcast' ;

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

my ($compress, $columns, $rows) = get_options() ;

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

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

sub get_options
{
my ($compress, $columns, $rows) ;