Wine Cross Reference
wine/tools/winapi/output.pm

   #
   # Copyright 1999, 2000, 2001 Patrik Stridvall
   #
   # This library is free software; you can redistribute it and/or
   # modify it under the terms of the GNU Lesser General Public
   # License as published by the Free Software Foundation; either
   # version 2.1 of the License, or (at your option) any later version.
   #
   # This library is distributed in the hope that it will be useful,
  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  # Lesser General Public License for more details.
  #
  # You should have received a copy of the GNU Lesser General Public
  # License along with this library; if not, write to the Free Software
  # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  #
  
  package output;
  
  use strict;
  
  use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  require Exporter;
  
  @ISA = qw(Exporter);
  @EXPORT = qw();
  @EXPORT_OK = qw($output);
  
  use vars qw($output);
  
  $output = '_output'->new;
  
  package _output;
  
  use strict;
  
  my $stdout_isatty = -t STDOUT;
  my $stderr_isatty = -t STDERR;
  
  sub new($) {
      my $proto = shift;
      my $class = ref($proto) || $proto;
      my $self  = {};
      bless ($self, $class);
  
      my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
      my $progress = \${$self->{PROGRESS}};
      my $last_progress = \${$self->{LAST_PROGRESS}};
      my $last_time = \${$self->{LAST_TIME}};
      my $progress_count = \${$self->{PROGRESS_COUNT}};
      my $prefix = \${$self->{PREFIX}};
      my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
  
      $$progress_enabled = 1;
      $$progress = "";
      $$last_progress = "";
      $$last_time = 0;
      $$progress_count = 0;
      $$prefix = undef;
      $$prefix_callback = undef;
  
      return $self;
  }
  
  sub DESTROY {
      my $self = shift;
  
      $self->hide_progress;
  }
  
  sub enable_progress($) {
      my $self = shift;
      my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
  
      $$progress_enabled = 1;
  }
  
  sub disable_progress($) {
      my $self = shift;
      my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
  
      $$progress_enabled = 0;
  }
  
  sub show_progress($) {
      my $self = shift;
      my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
      my $progress = ${$self->{PROGRESS}};
      my $last_progress = \${$self->{LAST_PROGRESS}};
      my $progress_count = \${$self->{PROGRESS_COUNT}};
  
      $$progress_count++;
  
      if($$progress_enabled) {
          if($$progress_count > 0 && $$progress && $stderr_isatty) {
              # If progress has more than $columns characters the xterm will
              # scroll to the next line and our ^H characters will fail to
              # erase it.
             my $columns=$ENV{COLUMNS} || 80;
             $progress = substr $progress,0,($columns-1);
             print STDERR $progress;
             $$last_progress = $progress;
         }
     }
 }
 
 sub hide_progress($)  {
     my $self = shift;
     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
     my $progress = \${$self->{PROGRESS}};
     my $last_progress = \${$self->{LAST_PROGRESS}};
     my $progress_count = \${$self->{PROGRESS_COUNT}};
 
     $$progress_count--;
 
     if($$progress_enabled) {
         if($$last_progress && $stderr_isatty) {
             my $message=" " x length($$last_progress);
             print STDERR $message;
             undef $$last_progress;
         }
     }
 }
 
 sub update_progress($) {
     my $self = shift;
     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
     my $progress = ${$self->{PROGRESS}};
     my $last_progress = \${$self->{LAST_PROGRESS}};
 
     if($$progress_enabled) {
         # If progress has more than $columns characters the xterm will
         # scroll to the next line and our ^H characters will fail to
         # erase it.
         my $columns=$ENV{COLUMNS} || 80;
         $progress = substr $progress,0,($columns-1);
 
         my $prefix = "";
         my $suffix = "";
         if($$last_progress) {
             $prefix = "" x length($$last_progress);
 
             my $diff = length($$last_progress)-length($progress);
             if($diff > 0) {
                 $suffix = (" " x $diff) . ("" x $diff);
             }
         }
         print STDERR $prefix, $progress, $suffix;
         $$last_progress = $progress;
     }
 }
 
 sub progress($$) {
     my $self = shift;
     my $progress = \${$self->{PROGRESS}};
     my $last_time = \${$self->{LAST_TIME}};
 
     my $new_progress = shift;
     if(defined($new_progress)) {
         if(!defined($$progress) || $new_progress ne $$progress) {
             $$progress = $new_progress;
 
             $self->update_progress;
             $$last_time = 0;
         }
     } else {
         return $$progress;
     }
 }
 
 sub lazy_progress($$) {
     my $self = shift;
     my $progress = \${$self->{PROGRESS}};
     my $last_time = \${$self->{LAST_TIME}};
 
     $$progress = shift;
 
     my $time = time();
     if($time - $$last_time > 0) {
         $self->update_progress;
         $$last_time = $time;
     }
 }
 
 sub prefix($$) {
     my $self = shift;
     my $prefix = \${$self->{PREFIX}};
     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 
     my $new_prefix = shift;
     if(defined($new_prefix)) {
         if(!defined($$prefix) || $new_prefix ne $$prefix) {
             $$prefix = $new_prefix;
             $$prefix_callback = undef;
         }
     } else {
         return $$prefix;
     }
 }
 
 sub prefix_callback($) {
     my $self = shift;
 
     my $prefix = \${$self->{PREFIX}};
     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 
     $$prefix = undef;
     $$prefix_callback = shift;
 }
 
 sub write($$) {
     my $self = shift;
 
     my $message = shift;
 
     my $prefix = \${$self->{PREFIX}};
     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
 
     $self->hide_progress if $stdout_isatty;
     if(defined($$prefix)) {
         print $$prefix . $message;
     } elsif(defined($$prefix_callback)) {
         print &{$$prefix_callback}() . $message;
     } else {
         print $message;
     }
     $self->show_progress if $stdout_isatty;
 }
 
 1;