File Coverage

blib/lib/Term/Report.pm

Criterion	Covered	Total	%
statement	3	113	2.6
branch	0	52	0.0
condition	0	23	0.0
subroutine	1	14	7.1
pod	8	11	72.7
total	12	213	5.6

package Term::Report;
no warnings 'portable';

$|++;
require 5.6.0;
our ($CR, $FH);
our $VERSION = '1.18';


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

   my $self = bless {
      curText     => undef,
      prevText    => undef,
      currentRow  => $params{startRow} || 1,
      startRow    => $params{startRow} || 1,
      startCol    => $params{startCol} || 1,
      numFormat   => $params{numFormat},
      statusBar   => $params{statusBar},
      SP          => {},   ## Save point list
      noPrint     => 0,    ## Delays printing of text
      fh          => $params{fh} || *STDOUT,
   }, ref($class) || $class;

   $FH = $self->{fh};

   ## Do we want to format numbers?
   if ($self->{numFormat}){
      if ($self->loadModule("Number::Format", "numFormat")){
         if (ref($self->{numFormat}) ne 'ARRAY'){
            $self->{numFormat} = Number::Format->new(
                    -MON_DECIMAL_POINT => ',',
                    -INT_CURR_SYMBOL => '',
                    -DECIMAL_DIGITS => 0,
            );
         }
         else{
            $self->{numFormat} = Number::Format->new(@{$self->{numFormat}});
         }
      }
   }

   ## Do we have a Term::StatusBar?
   if ($self->{statusBar}){
      if ($self->loadModule("Term::StatusBar", "statusBar")){
         if (ref($self->{statusBar}) ne "ARRAY"){
            $self->{statusBar} = Term::StatusBar->new(fh=>$self->{fh});
         }
         else{
            push @{$self->{statusBar}}, ("fh", $self->{fh});
            $self->{statusBar} = Term::StatusBar->new(@{$self->{statusBar}});
         }
      }
   }

   ## If Term::StatusBar is inside, we will override
   ## it's SIG{INT}. If not wrapped and called after
   ## we are created, SIG{INT} will not 'behave' and
   ## will drop the cursor on the 2nd row rather than
   ## 2 rows down from current cursor position.
   $CR = \$self->{currentRow};
   $SIG{INT} = \&{__PACKAGE__."::sigint"};

   if (!defined $params{cls} || $params{cls}){ print $FH "\033[2J\033[0;0H"; }

   return $self;
}


##
## This must be done manually now since trying to do it
## in DESTROY causes problems in many instances
##
sub finished {
	print $FH "\033[$$CR;1H\033[0m\n\n";
}

##
## Just in case this isn't done in caller. We
## need to be able to reset the display.
##
sub sigint {
	finished();
   exit;
}


##
## Attempt to load module
##

sub loadModule {
   my ($self, $module, $key) = @_;

   eval "require $module";

   if ($@){
      $self->{$key} = 0;
      return 0;
   }
   return 1;
}

##
## Used to get/set object variables.
##
sub AUTOLOAD {
   my ($self, $val) = @_;
   (my $method = $AUTOLOAD) =~ s/.*:://;

   if (exists $self->{$method}){
      if (defined $val){
         $self->{$method} = $val;
      }
      else{
         return $self->{$method};
      }
   }
}


##
## Clears the screen
##
sub clear {
   print $FH "\033[2J\033[0;0H";
   $self->{currentRow} = $self->{startRow};
}


##
## Prints text to screen based on manual
## cursor positioning.
##
sub finePrint {
   my ($self, $row, $col, @text) = @_;
   my $text = join('', @text);

   ## Passed a save point label
   if ($row !~ /^\d+$/){
      my $label = $row;

      if (!exists $self->{SP}->{$label}){
         die "\033[20;0HNo SavePoint by the name <$label>\n";
      }
      $row  = $self->{SP}->{$label}->row;

      if (my $t = $self->{SP}->{$label}->text){
         ## We only want to reset once to avoid
         ## flickering as much as possible
         if (!$self->{SP}->{$label}->reset){
            ## Clear current row to replace text
            print $FH "\033[$row;1H\033[K";
            $text = $t.$text;
            $self->{SP}->{$label}->reset(1);
            $col = $self->{SP}->{$label}->col;
         }
         else{
            $col = $self->{SP}->{$label}->textLen+1;
         }
      }
      else{
         $col  = $self->{SP}->{$label}->textLen;
      }
   }

   print $FH "\033[$row;${col}H";
   $self->{currentRow} = $row if $row > $self->{currentRow};

   if ($self->{numFormat}){
      $text =~ s/(\d+)/$self->{numFormat}->format_number($1)/sge;
   }

   print $FH $text;
}


##
## Prints text to screen based on current
## cursor positioning.
##
sub printLine {
  my $self = shift;
  my $text = join('', @_);

  if ($self->{numFormat}){
    $text =~ s/(\d+)/$self->{numFormat}->format_number($1)/sge;
  }

  if (!$self->{prevText}){
    $self->adjustCurRow(\$text);
    print $FH "\033[$self->{currentRow};$self->{startCol}H";
    $self->{prevText} = $text;
  }
  else{
    if ($self->{prevText} !~ /\n/){
      if ($text =~ /^\n/){
        $self->adjustCurRow(\$text);
        $self->{prevText} = $text;
        print $FH "\033[$self->{currentRow};$self->{startCol}H";
      }
      else{
        $self->{prevText} .= $text;
        print $FH "\033[$self->{currentRow};", (length($self->{prevText})), "H";
      }
    }
    else{
      $self->{currentRow} += ($self->{prevText} =~ s/\n/\n/g);
      $self->adjustCurRow(\$text);
      $self->{prevText} = $text;
      print $FH "\033[$self->{currentRow};$self->{startCol}H";
    }
  }

  $self->{curText} = $text;
  print $FH $text if !$self->{noPrint};
}


##
## Keeps track of where current row
## should be for line placements
##
sub adjustCurRow{
   my ($self, $text) = @_;
   my $len = length($$text);
   $$text =~ s/^\n+//;
   $self->{currentRow} += ($len - length($$text));
}

##
## Returns length of text
##
sub lineLength {
  length shift()->{shift()};
}


##
## Prints out a bar report.
##
sub printBarReport {
  my ($self, $header, $config) = @_;

  return if !defined $self->{statusBar};
  $self->printLine($header);

  ## Backwards compatibility
  my $temp = [];
  if (ref($config) eq 'HASH'){
    ## Just flatten hash
    @$temp = %$config;
    $config = $temp;
  }

  my $x=0;
  for my $k (@$config){
    my $num = int(($self->{statusBar}->{scale}/$self->{statusBar}->{totalItems}) * $config->[$x+1]);

    if ($num < length($config->[$x+1])){
      $num = length($config->[$x+1]);
    }

    $self->printLine($config->[$x], "\033[7;37m\033[40m", $config->[$x+1], " "x($num), "\033[0m\n");
    $x+=2;
  }
}


##
## Stores information on screen locations for
## easy referencing later in code
##
sub savePoint {
  my ($self, $label, $text, $print) = @_;
  return if !defined $label;

  if (defined $text){
    $self->{noPrint} = !$print;
    $self->printLine($text);
    $self->{noPrint} = 0;
  }

  $self->{SP}->{$label} = Term::Report::SP->new({
        label   => $label,
        text    => $self->{curText},
        textLen => $self->lineLength('curText'),
        row     => $self->currentRow(),
        col     => $self->{startCol},
  });
}


## Internal package to provide easy access
## to the report's save points
package Term::Report::SP;
*{__PACKAGE__."::AUTOLOAD"} = \&Term::Report::AUTOLOAD;

sub new {
  bless {
      label   => $_[1]->{label}   || undef,
      text    => $_[1]->{text}    || undef,
      textLen => $_[1]->{textLen} || undef,
      row     => $_[1]->{row}     || undef,
      col     => $_[1]->{col},
      reset   => 0,
  }, $_[0];
}


1;
__END__