File Coverage

blib/lib/ProgressMonitor/Stringify/ToStream.pm

Criterion	Covered	Total	%
statement	33	80	41.2
branch	0	26	0.0
condition	0	9	0.0
subroutine	11	16	68.7
pod	0	2	0.0
total	44	133	33.0

package ProgressMonitor::Stringify::ToStream;

use warnings;
use strict;

use ProgressMonitor::State;

use constant BACKSPACE => "\b";
use constant SPACE     => ' ';

require ProgressMonitor::Stringify::AbstractMonitor if 0;

# Attributes:
#	backspaces (string)
#		Precomputed string with backspaces used to return to the beginning so as
# 		to wipe out the previous write.
#
use classes
  extends  => 'ProgressMonitor::Stringify::AbstractMonitor',
  new      => 'new',
  attrs_pr => ['backspaces', 'needBS'],
  ;

sub new
{
	my $class = shift;
	my $cfg   = shift;

	my $self = $class->SUPER::_new($cfg, $CLASS);

	# initialize the rest
	#
	$self->{$ATTR_backspaces}  = undef;
	$self->{$ATTR_needBS} = 0;

	return $self;
}

sub render
{
	my $self = shift;

	local $| = 1;

	my $bs = $self->{$ATTR_backspaces};
	$bs = $self->{$ATTR_backspaces} = BACKSPACE x $self->get_width unless $bs;

	my $cfg     = $self->_get_cfg;
	my $stream  = $cfg->get_stream;
	my $bsAfter = $cfg->get_backspaceAfterRender;
	# render and print
	#
	print $stream $bs if (!$bsAfter && $self->{$ATTR_needBS});
	my $s = $self->_toString;
	print $stream $s;
	$self->{$ATTR_needBS} = ($s !~ /\n$/ ? 1 : 0);
	print $stream $bs if ($bsAfter && $self->{$ATTR_needBS});

	if ($self->_get_state == STATE_DONE)
	{
		# run the end routine
		#
		my $atEndStrategy = $cfg->get_atEndStrategy;
		if ($atEndStrategy eq 'wipe')
		{
			# space it out and return us to beginning
			#
			print $stream $bs unless $bsAfter;
			print $stream SPACE x $self->get_width;
			print $stream $bs;
		}
		elsif ($atEndStrategy eq 'newline')
		{
			# get us to a new line
			#
			print $stream "\n";
		}
		else
		{
			# the strategy is 'none'...
			#
		}
	}

	return;
}

sub setErrorMessage
{
	my $self = shift;
	my $msg  = $self->SUPER::setErrorMessage(shift());

	if ($msg)
	{
		my $stream = $self->_get_cfg->get_stream;
		print $stream "\n$msg\n";
		$self->{$ATTR_needBS} = 0;

		$self->render;
	}
}

###

package ProgressMonitor::Stringify::ToStreamConfiguration;

use strict;
use warnings;

use Scalar::Util qw(openhandle);

my $tsPlatform = $^O eq 'MSWin32' ? 'Win32' : 'Unix';
eval "use Term::Size::$tsPlatform";
die("Platform specific use failed: $@") if $@;

# Attributes
#	stream (handle)
#		This is the stream to write to. Defaults to '\*STDOUT'.
#       The stream must be able to handle backspacing in order to properly
#       show the fields. Also, this presumes things won't go awry if the
#		width set exceeds the streams 'display width' (e.g. a terminal window),
#       causing linewrapping to occur.
#	atEndStrategy (string, default => 'newline')
#       'wipe'   : the rendered data will be cleared on completion, cursor
#                  at the point where it started.
#       'newline': the rendered data will be left, a newline positions the
#                  cursor on next line.
#       'none'   : the rendered data will be left, the cursor remains at the
#                  end
#	backspaceAfterRender (boolean, default => 0)
#       Whether the cursor should be backspaced to the start of the render or
#       left at the end of the render
#
use classes
  extends => 'ProgressMonitor::Stringify::AbstractMonitorConfiguration',
  attrs   => ['stream', 'atEndStrategy', 'backspaceAfterRender'],
  ;

sub defaultAttributeValues
{
	my $self = shift;

	return {%{$self->SUPER::defaultAttributeValues()}, stream => \*STDOUT, atEndStrategy => 'newline', backspaceAfterRender => 0};
}

sub checkAttributeValues
{
	my $self = shift;

	$self->SUPER::checkAttributeValues();

	my $stream = $self->get_stream;
	X::Usage->throw("not an open handle") unless openhandle($stream);

	# try to actually get the columns for the given stream and adapt the maxwidth to it
	# if it's not explicitly set - failing this, fall back to a hardcoded 79...
	#
	if (!$self->get_maxWidth)
	{
		my $cols;
		eval "\$cols = Term::Size::${tsPlatform}::chars \$stream;";
		$self->set_maxWidth(($cols && !$@) ? $cols - 1 : 79);
	}

	my $aes = $self->get_atEndStrategy;
	X::Usage->throw("invalid value for atEndStrategy: $aes") unless $aes =~ /^(?:none|wipe|newline)$/;

	return;
}

############################

=head1 NAME

ProgressMonitor::Stringify::ToStream - a monitor implementation that prints
stringified feedback to a stream.

=head1 SYNOPSIS

  ...
  # call someTask and give it a monitor that prints to stdout
  #
  someTask(ProgressMonitor::Stringify::ToStream->new({fields => [ ... ]}));

=head1 DESCRIPTION

This is a concrete implementation of a ProgressMonitor. It will send the stringified
feedback to a stream and backspace to continously overwrite. Optionally, it will
clear the feedback entirely, leaving the cursor where it was.

Note that this is probably most useful to send to either stdout/stderr. Sending to
a basic disk file probably won't many people happy...See ToCallback if you want to
be more clever.

Also, this assumes that backspacing will work correctly which may not be true if
the width is so large that the terminal window starts on a new line. Use the inherited
configuration 'maxWidth' to limit the width if you have the necessary information.

Inherits from ProgressMonitor::Stringify::AbstractMonitor.

=head1 METHODS

=over 2

=item new( $hashRef )

Configuration data:

=over 2

=item stream (default => \*STDOUT)

This is the stream to write to. Defaults to '\*STDOUT'.

The stream must be able to handle backspacing in order to properly
show the fields. Unless the maxWidth is explicitly set, it will be
set by checking the stream using Term::Size(::).

=item atEndStrategy (default => 'newline')

=over 2

=item wipe

The rendered data will be cleared on completion, cursor at the point where it started.

=item newline

The rendered data will be left, a newline positions the cursor on next line.

=item none

The rendered data will be left, the cursor remains at the end.

=back

=back

=back

=head1 AUTHOR

Kenneth Olwing, C<<  >>

=head1 BUGS

I wouldn't be surprised! If you can come up with a minimal test that shows the
problem I might be able to take a look. Even better, send me a patch.

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find general documentation for this module with the perldoc command:

    perldoc ProgressMonitor

=head1 ACKNOWLEDGEMENTS

Thanks to my family. I'm deeply grateful for you!

=head1 COPYRIGHT & LICENSE

Copyright 2006,2007 Kenneth Olwing, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;    # End of ProgressMonitor::Stringify::ToStream