1#@!#!123s

: / opt / dedrads / perl / IMH /
Filename : Progress.pm
back
package IMH::Progress;

use strict;
use warnings;

{
  package IMH::Progress::Spinner;

  use strict;
  use warnings;
  use IMH::Terminal;
  use Class::Struct;
  use Data::Dumper;

  our @DEFAULT_GLYPHS = qw( | / - \\ | / - \\ );

  struct(
    glyphs       => '@',
    frequency    => '$',
    cursor       => '$',
    glyph        => '$',
    width        => '$',
    device       => '$'
  );

  sub create {
    my ( $class, %params ) = @_;

    $params{ glyphs }       ||= [ @DEFAULT_GLYPHS ];
    $params{ frequency }    ||= 1;
    $params{ cursor }         = 0;
    $params{ glyph }        ||= 0;
    $params{ width }        ||= screen_width();

    my $o =  $class->new( %params );
    $o->device( $params{ device } || \*STDERR );
    return $o;
  }

  sub update {
    my ( $self, $label ) = @_;

    local $| = 1;
    if ( $self->cursor == 0 ) {
      my $out          = $self->device;
      my $screen_width = $self->width;
      my $line         = sprintf( "%s   %s", $self->glyphs->[ $self->glyph ], $label );

      my $n = clen( $line );
      if ( $n > $screen_width ) {
        $line = substr( $line, 0, $screen_width - 4 ) . '...';
      }

      print $out "\e[0m\r\e[2K";   # clears the line
      print $out $line;
    }

    $self->cursor( $self->cursor % $self->frequency );
    $self->glyph( ( $self->glyph + 1 ) % ( scalar( @{ $self->glyphs } ) - 1 ) );
  }

  sub wipe {
    my ( $self ) = @_;
    my $out = $self->device;

    # force flush on print for the duration of this block
    local $| = 1;

    # return to the start of the line and clear its content
    print $out "\r\e[2K";
  }
}



# Preloaded methods go here.

{
  package IMH::Progress::Bar;

  use strict;
  use warnings;
  use IMH::Terminal;
  use Text::Tabs;
  use Class::Struct;
  use POSIX qw( floor );
  use Data::Dumper;

  struct(
    total        => '$',
    cursor       => '$',
    percent      => '$',
    width        => '$',
    message      => '$',
    device       => '$'
  );

  sub create {
    my ( $class, %params ) = @_;

    $params{ total }        ||= 100;
    $params{ cursor }         = 0;
    $params{ message }      ||= '';
    $params{ width }        ||= screen_width();

    my $o =  $class->new( %params );
    $o->device( $params{ device } || \*STDERR );
    $o->percent( 0 );
    return $o;
  }

  sub step {
    my ( $self, $step, $message ) = @_;

    my $cursor           = $self->cursor;
    my $total            = $self->total;
    my $previous_percent = $self->percent;
    my $previous_message = $self->message;
    $message           ||= $previous_message;

    $cursor += $step;
    $self->cursor( $cursor );
    my $new_percent = floor( $cursor * 100 / $total );

    if ( $new_percent != $previous_percent or $message ne $previous_message ) {
      $self->percent( $new_percent );
      $self->message( $message );
      $self->draw;
    }
    return $self;
  }


  sub draw {
    my ( $self ) = @_;
    my $cursor           = $self->cursor;
    my $total            = $self->total;
    my $width            = $self->width;
    my $percent          = $self->percent;
    my $message          = $self->message;
    my $blocks           = floor( ( $cursor / $total ) * $width );

    my $text = ljust( expand( sprintf( "%3i%%\t%-s", $percent, $message ) ), $width );
    if ( clen( $text ) > $width ) {
      $text = substr( $text, 0, cindex( $text, $width - 3 ) ) . "...\e[0m";
    }
    #printf "%s %s\n", screen_width, clen( $text );
    my $cleave  = cindex( $text, $blocks );
    my $color_portion = substr( $text, 0, $cleave );
    my $blank_portion = substr( $text, $cleave );
    my $bar = "\e[41m" . $color_portion . "\e[0m" . $blank_portion;
    my $out = $self->device;


    local $| = 1;
    print $out "\r\e[2K";
    print $out $bar;

  }


  sub cindex {
    my ( $str, $index ) = @_;
    my $skipped = 0;

    while ( $str =~ /\e\[.*?m/g ) {
      my $escape_length = length( $& );

      my $stop = $-[ 0 ];
      if ( $stop - $skipped > $index ) {
        return $index + $skipped;
      } else {
        $skipped += $escape_length;
      }
    }

    return $index + $skipped;
  }


  sub wipe {
    my ( $self ) = @_;
    my $out = $self->device;

    # force flush on print for the duration of this block
    local $| = 1;

    # return to the start of the line and clear its content
    print $out "\r\e[2K";
  }

}

1;
__END__
=head1 NAME

IMH::Progress - Tools to display program progress information on the command line

=head1 SYNOPSIS

  use IMH::Progress;

  # create a general progress indicator that will refresh every 100 calls to update
  my $progress = IMH::Progress::Spinner->create( frequency => 100 );

  while ( `heavy command` ) {
    chomp;
    $progress->update( "RUNNING: $_" );
    ...
  }

  $progress->wipe;

=head1 AUTHOR

Kyle Yetter, E<lt>kyley@inmotionhosting.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 by Kyle Yetter.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.


=cut