App-Textcast
2 results

 view release on metacpan or  search on metacpan

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


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)

Check that the given output directory does B<not> exist. If B<$output_directory> is not defined, a directory
name is generated.

I<Arguments>

=over 2 

=item * $output_directory - The name of the directory where the textcast is recorded

=back

I<Returns> - The directory where the textcast is recorded.

I<Exceptions>

=over 2 

=item * Textcast directory already exists

=item * Path too long - length must be under 256 characters.

=item * Invalid path - Path can only contain alphanumerics and path separator.

=back

=cut

my ($directory) = @_ ;

unless(defined $directory)
	{
	my $now_string = localtime;  # e.g., "Thu Oct 13 04:54:34 1994"
	$now_string=~ s/[^[:digit:][:alpha:]]/_/sxmg ;
	
	$directory = "textcast_recorded_on_$now_string" ;
	}

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


=item ROW - row where the status is displayed

=item COLUMNS - column where the status is displayed

=back 

=back

I<Returns> - A list containing

=over 2 

=item * $total_play_time

=item * $played_frames

=item * \@skipped_frames

=back

I<Exceptions> - None

=cut

my ($input_directory, $screenshot_information, $display_status,) = @_ ;

my $total_frames = scalar(@{$screenshot_information}) ;

my ($total_play_time, $played_frames, @skipped_frames) ;

my $frame_display_time = 0 ;

for my $file_information (@{$screenshot_information})
	{
	my $file = "$input_directory/$file_information->{file}" ;
	$total_play_time += $file_information->{delay} ;
	
	if(-e $file)
		{
		$played_frames++ ;
		
		status
			(
			sprintf( "F: $played_frames/$total_frames [%0.2f]", $file_information->{delay}),
			$display_status->{ROW},
			$display_status->{COLUMN},
			) if $display_status->{DISPLAY} ;
		
		my $sleep_time = $file_information->{delay} - $frame_display_time ;
		
		# split sleep time in smaller chunks if we want to handle the user input
		Readonly my $ONE_MILLION => 1_000_000 ;
		
		usleep $sleep_time * $ONE_MILLION if($sleep_time > 0) ;
		
		$frame_display_time = [gettimeofday]  ;
		
		print #$SHOW_CURSOR,
			read_file($file),
			position_cursor($file_information->{cursor_y}, $file_information->{cursor_x}) ;
		
		$frame_display_time = tv_interval($frame_display_time , [gettimeofday]) ;
		}
	else
		{
		carp "Error: Can't find '$file'! Skipping.\n" ;
		push @skipped_frames, $file ;
		}
	}

return ($total_play_time, $played_frames, \@skipped_frames) ;
}

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

sub print_play_information
{

=head2 [p] print_play_information($total_play_time, $played_frames, \@skipped_frames)

Displays information about the textcast replay.

  print_play_information
	(
	$total_play_time,
	$total_frames,
	$played_frames,
	\@skipped_frames,
	) ;

I<Arguments>

=over 2 

=item * $total_play_time - Float - play time in seconds

=item * $played_frames - Integer - number of framed played, maybe less than $total_frames

=item * \@skipped_frames - Integer - number of frames skipped because they couldn't be found

=back

I<Returns> - Nothing

I<Exceptions> - None

=cut

my ($total_play_time, $played_frames, $skipped_frames) = @_ ;

my $play_time = sprintf('%0.2f', $total_play_time) ;

print "play_textcast: $played_frames frames played in $play_time seconds.\n" ;

if(@{$skipped_frames})
	{
	print "Skipped:\n\t" . join("\n\t", @{$skipped_frames}) . "\n" ;
	}
	
return ;
}

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

sub status
{

=head2 [p] status($status, $status_row, $status_column)

Displays a status on the status line.

I<Arguments>

=over 2 

=item * $status - String to be displayed on the terminal

=item * $status_row - Integer - row position for the status

=item * $status_column - Integer - column position for the status

=back

I<Returns> - Nothing

I<Exceptions> - None

=cut

my ($status, $status_row, $status_column) = @_ ;

print $SAVE_CURSOR_POSITION, 
	position_cursor($status_row, $status_column),
	$CLEAR_LINE,
	$status,
	$RESTORE_CURSOR_POSITION ;

return ;
}

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

sub position_cursor
{

=head2 [p] position_cursor($row, $column)

Create an ANSI command to position the cursor on the terminal.

I<Arguments>

=over 2 

=item * $row - Integer - row position for the status

=item * $column - Integer - column position for the status

=back

I<Returns> - A string containing the ANSI command.

I<Exceptions> - None

See C<xxx>.

=cut

my ($row, $column) = @_ ;

return "\e[${row};${column}H" ;
}

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

sub load_index
{

=head2 [p] load_index($input_directory)

Loads the screencast meta-data.

I<Arguments>

=over 2 

=item * $input_directory - The directory containing the textcast

=back

I<Returns> - The screencast meta-data, see the index file for format information.

I<Exceptions>

=over 2

=item * Index not found

=item * Invalid data in index

=back

=cut

my ($input_directory) = @_ ;

my @screenshot_information ;

if(-e "$input_directory/index")
	{
	print "Parsing index ...\n" ;
	my @entries = read_file("$input_directory/index") ;
	
	my $line = 0 ;
	
	my $regex = '{file => 0, delay => 0.0, cursor_x => 1, cursor_y => 1, size => 1, terminal_rows => 1, terminal_columns => 1, },' ;
	$regex =~ s/^{/^{/sxm ;
	$regex =~ s/([^[:digit:]]+)$/$1\$/sxmg ;
	$regex =~ s/[[:digit:]]+/[[:digit:]]+/sxmg ;
	
	my @errors ;
	
	for my $entry (@entries)
		{
		unless($entry =~ $regex)
			{
			push @errors, "\tInvalid index entry at line $line!\n" ;
			}
			
		$line++ ;
		}
	
	if(@errors)
		{
		local $ERRNO = 2 ;
		croak "Error: Invalid index!\n@errors" ;
		}
	
	@screenshot_information = eval "@entries"  ## no critic (BuiltinFunctions::ProhibitStringyEval)
		or croak "Error: Couldn't parse index file! $@ $!\n" ;
	}
else
	{
	local $ERRNO = 2 ;
	croak "Error: No index found! $!\n"  ;
	}
	
return \@screenshot_information ;
}

#---------------------------------------------------------------------------------------------------------
# VT102
# Everything below is based on the Term::VT102 example
# Logs all terminal output to STDERR if STDERR is redirected to a file.
#---------------------------------------------------------------------------------------------------------

sub create_vt102_sub_process
{

=head2 [p] create_vt102_sub_process($shell_command, $columns, $rows)


I<Arguments>

=over 2 

=item * $shell_command, $columns, $rows - 

=back

I<Returns> - a vt_process handle

I<Exceptions>

=cut

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


# Child process - set up stdin/out/err and run the command.
# Become process group leader.
if (not POSIX::setsid ()) 
	{
	carp "Couldn't perform setsid: $!";
	}

# Get details of the slave side of the pty.
my $tty = $pty->slave ();
my $tty_name = $tty->ttyname();

# Linux specific - commented out, we'll just use stty below.
#
#	# Set the window size - this may only work on Linux.
#	#
#	my $winsize = pack ('SSSS', $vt->rows, $vt->cols, 0, 0);
#	ioctl ($tty, &IO::Tty::Constant::TIOCSWINSZ, $winsize);

# File descriptor shuffling - close the pty master, then close
# stdin/out/err and reopen them to point to the pty slave.
close ($pty);

close (STDIN);
open (STDIN, '<&' . $tty->fileno ()) || croak 'Error: Couldn\'t reopen ' . $tty_name . " for reading: $!";

close (STDOUT);
open (STDOUT, '>&' . $tty->fileno()) || croak 'Error: Couldn\'t reopen ' . $tty_name . " for writing: $!";

close (STDERR);
open (STDERR, '>&' . $tty->fileno()) || croak "Error: Couldn't redirect STDERR: $!";

# Set sane terminal parameters.
system 'stty sane';

# Set the terminal size with stty.
system 'stty rows ' . $vt->rows;
system 'stty cols ' . $vt->cols;

# Finally, run the command, and die if we can't.
exec $command or croak "Error: Cannot exec '$command': $!";
}

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

sub check_sub_process_output
{

=head2 [p] check_sub_process_output( $vt_process)

Check the sub process output.

I<Arguments>

=over 2 

=item * $vt_process - 

=back

I<Returns> - $eof, $screen_data, $cursor_x, $cursor_y

I<Exceptions> - None

=cut

my ($vt_process) = @_;	
my $vt = $vt_process->{VT} ;

my ($eof, $screen_data) ;

my $rin = $EMPTY_STRING ;
vec ($rin, $vt_process->{PTY}->fileno, 1) = 1;
vec ($rin, $vt_process->{IOT}->fileno, 1) = 1;

my ($win, $ein) = ($EMPTY_STRING, $EMPTY_STRING) ;
my($rout, $wout, $eout) ;
select ($rout=$rin, $wout=$win, $eout=$ein, 1);

# Read from the command if there is anything coming in, and
# pass any data on to the Term::VT102 object.
my $cmdbuf = $EMPTY_STRING ;

Readonly my $BUFFER_READ_SIZE => 1024 ;

if (vec($rout, $vt_process->{PTY}->fileno, 1)) 
	{
	my $bytes_read = $vt_process->{PTY}->sysread ($cmdbuf, $BUFFER_READ_SIZE);
	$eof = 1 if ((defined $bytes_read) && ($bytes_read == 0));
	
	if ((defined $bytes_read) && ($bytes_read > 0)) 
		{
		$vt->process ($cmdbuf);
		syswrite STDERR, $cmdbuf if (! -t STDERR);
		}
	}
	
# End processing if we've gone 1 round after command died with no output.
$eof = 1 if ($vt_process->{DIED} && $cmdbuf eq $EMPTY_STRING);

# Do your stuff here - use $vt->row_plaintext() to see what's on various
# rows of the screen, for instance, or before this main loop you could set
# up a ROWCHANGE callback which checks the changed row, or whatever.

# In this example, we just pass standard input to the SSH command, and we
# take the data coming back from SSH and pass it to the Term::VT102 object,
# and then we repeatedly dump the Term::VT102 screen.

# Read key presses from standard input and pass them to the command
# running in the child process.
if (vec ($rout, $vt_process->{IOT}->fileno, 1)) 
	{
	my $stdinbuf = $EMPTY_STRING ;
	my $bytes_read = $vt_process->{IOT}->sysread ($stdinbuf, $BUFFER_READ_SIZE );
	$eof = 1 if ((defined $bytes_read) && ($bytes_read == 0));
	$vt_process->{PTY}->syswrite ($stdinbuf, $bytes_read) if ((defined $bytes_read) && ($bytes_read > 0));
	}

# Dump what Term::VT102 thinks is on the screen. We only output rows
# we know have changed, to avoid generating too much output.
my $didout = 0;



( run in 0.903 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )