# $Id: SingleLinePrinter.pm,v 1.7 2005/02/07 22:09:57 mitch Exp $
# 2005 (c) by Christian Garbs <mitch@cgarbs.de>
# Licensed under GNU GPL
use strict;

package SingleLinePrinter;

=head1 NAME

SingleLinePrinter

=head1 SYNOPSIS

  use SingleLinePrinter;
  my $slp = new SingleLinePrinter( sub { sleep 1 } );
  $slp->print($_) while <>;

=head1 OVERVIEW

SingleLinePrinter allows you to print multiple lines of text one after
another into just one line on your screen.

It can be used to monitor longer activities like showing filesnames
written to a backup, which would fill up your screen and and start to
scroll if every filename would be written into a new line.

This could also be used to print moving bars or rotating cursors.

SingleLinePrinter does not only print the text, it also calls a
user-specified function.  You can use it as a wrapper around an
existing function that does a lot of work and should be monitored
(like the file archive routine mentioned above).

=cut

=head1 METHODS

=over 4

=cut

sub new() {

=item SingleLinePrinter::new();

This instanciates a new SingleLinePrinter object.  It takes up to
four parameters (position dependent!) which are as follows:

=over

=item CALLBACK

The reference to a callback function that is executed every time
print() is called on this object.  Default value is an empty anonymous
subroutine.

=item MAXLENGTH

The maximum line length that can be printed.  Default is 79
characters.

=item LEFTBOUND

The alignment of the text if it is longer than the maximum line
length.  Default is true which means to cut off the rightmost
characters.

item FILEHANDLE

The filehandle to print to.  The default is to use STDOUT.  This value
should be passed as a glob reference, e.g. C<\*STDERR> for STDERR.

=back

=cut

    my $pkg = shift;
    my $self = {
	'CALLBACK' => sub {},
	'MAXLENGTH' => 79,
	'LEFTBOUND' => 1,
	'FILEHANDLE' => \*STDOUT
	};
    $self->{'CALLBACK'}   = shift if @_;
    $self->{'MAXLENGTH'}  = shift if @_;
    $self->{'LEFTBOUND'}  = shift if @_;
    $self->{'FILEHANDLE'} = shift if @_;

    my $old_fh = select($self->{'FILEHANDLE'});
    $| = 1;
    select($old_fh);

    bless $self, $pkg;
}

sub print() {

=item SingleLinePrinter::print();

This will print the given text (first parameter) and then call the
callback function with any remaining parameters.  When the callback
function returns, the printed text is overwritten and the cursor moved
back to the original position.  The callback function should not print
any output or the screen may become garbled.

The printed text will be cut off and aligned according to the values
given on instanciation.

If no parameter is given, then no text is printed.  If no or only one
parameter is given, then the callback function is called without
parameters.

A return value of the callback function is passed through and returned
by print().

=cut

    my $self = shift;
    my $line = '';
    my $fh = $self->{'FILEHANDLE'};
    $line = shift if @_;
    chomp $line;
    if (length $line > $self->{'MAXLENGTH'}) {
	if ($self->{'LEFTBOUND'}) {
	    $line = substr $line, 0, $self->{'MAXLENGTH'};
	} else {
	    $line = substr $line, -$self->{'MAXLENGTH'};
	}
    }
    print $fh $line;

    my (@ret, $ret);
    if (wantarray) {
        @ret = &{$self->{'CALLBACK'}}(@_);
    } else {
        $ret = &{$self->{'CALLBACK'}}(@_);
    }

    print $fh "\r";
    print $fh ' ' x length $line;
    print $fh "\r";

    return unless defined wantarray;
    return wantarray ? @ret : $ret;
}

=back

=head1 EXAMPLES

=head2 Basic usage

This piece of code reads text from stdin and prints it line by line to
stdout, sleeping 1 second per line.  It uses an anonymous subroutine
which is called for every printed line to do the sleeping:

  use SingleLinePrinter;
  my $slp = new SingleLinePrinter( sub { sleep 1 } );
  $slp->print($_) while <>;

This does the same, but without an anonymous subroutine:

  use SingleLinePrinter;
  sub callback {
      sleep 1;
  }
  my $slp = new SingleLinePrinter( \&callback );
  $slp->print($_) while <>;

=head2 Customizing SingleLinePrinter

In this example, only 10 characters are printed per line.  Lines
longer than 10 characters have only their last 10 characters printed.
Output is sent to STDERR instead of STDOUT.

  use SingleLinePrinter;
  my $slp = new SingleLinePrinter(
                    sub { sleep 1 },  # CALLBACK
                    10,               # MAXLENGTH:  10 chars
                    0,                # LEFTBOUND:  false = rightbound
                    \*STDERR          # FILEHANDLE: STDERR
                );
  $slp->print($_) while <>;

=head2 Passing parameters

In this example, the callback function expects parameters and returns
something as well:

  use SingleLinePrinter;
  sub is_prime($) {
      # check if given number is prime
      #   return number if prime
      #   return empty list of not prime
      my $number = shift;
      foreach my $j (2..($number/2)) {
        return () if $number % $j == 0;
      }
      return $number;
  }
  my $slp = new SingleLinePrinter( \&is_prime );
  my @primes;
  foreach my $i (100000..105000) {
      push @primes, $slp->print(
                                "checking $i", # text to print
                                $i             # parameter for
                                               # callback function
                                );
  }
  print "@primes\n";

=head1 TODO

=over

=item * Autodetect screen width

=item * Regression

=back

=head1 AUTHOR

SingleLinePrinter was written by Christian Garbs <F<mitch@cgarbs.de>>.

=head1 AVAILABILITY

An up-to-date version of this module can be found at
<L<http://www.cgarbs.de/singlelineprinter.en.html>>.

=head1 COPYRIGHT

 (c) 2005 by Christian Garbs
SingleLinePrinter is licensed under the GNU GPL.

=cut

1;