lib/Term/ProgressBar/IO.pm

   1 #  This program is free software; you can redistribute it and/or
   2 #  modify it under the same terms as Perl itself.
   3 # Copyright 2014 by Don Armstrong <don@donarmstrong.com>.
   4
   5 package Term::ProgressBar::IO;
   6
   7 =head1 NAME
   8
   9 Term::ProgressBar::IO -- Display a progress bar while reading from a seekable filehandle
  10
  11 =head1 SYNOPSIS
  12
  13   my $pb = Term::ProgressBar::IO->new($fh);
  14
  15   while (<$fh>) {
  16       # do something
  17       $pb->update();
  18   }
  19
  20 =head1 DESCRIPTION
  21
  22 Displays a progress bar using L<Term::ProgressBar> which corresponds
  23 to reading from a filehandle.
  24
  25 This module inherits from L<Term::ProgressBar> and has all of its
  26 options.
  27
  28 =head1 BUGS
  29
  30 None known.
  31
  32 =cut
  33
  34 use warnings;
  35 use strict;
  36 use vars qw($VERSION $DEBUG);
  37
  38 use parent qw(Term::ProgressBar);
  39 use Carp;
  40 use Fcntl qw(:seek);
  41
  42 BEGIN{
  43      $VERSION = q(0.1);
  44      $DEBUG = 0 unless defined $DEBUG;
  45 }
  46
  47 =head1 METHODS
  48
  49 =head2 new
  50
  51 Create and return a new Term::ProgressBar::IO instance.
  52
  53 =over
  54
  55 =item ARGUMENTS
  56
  57 =over
  58
  59 =item count
  60
  61 A valid filehandle or item count. L<IO::Uncompress> filehandles are
  62 also properly handled.
  63
  64 =item OTHER ARGUMENTS
  65
  66 All other arguments are documented in L<Term::ProgressBar>
  67
  68 =back
  69
  70 =back
  71
  72 =cut
  73
  74 sub init {
  75     my $self = shift;
  76     my $count;
  77     if (@_==2) {
  78         $count = $_[1];
  79     } else {
  80         croak
  81             sprintf("Term::ProgressBar::IO::new We don't handle this many arguments: %d",
  82                     scalar @_)
  83             if @_ != 1;
  84     }
  85     my %config;
  86     if ( UNIVERSAL::isa ($_[0], 'HASH') ) {
  87         ($count) = @{$_[0]}{qw(count)};
  88         %config = %{$_[0]};
  89     } else {
  90         ($count) = @_;
  91     }
  92     if (ref($count) and $count->can("seek")) {
  93         $self->{__filehandle} = $count;
  94         $count = $self->__determine_max();
  95     }
  96     $config{count} = $count;
  97     $self->SUPER::init(\%config);
  98 }
  99
 100 =head2 update
 101
 102 Automatically update the progress bar based on the position of the
 103 filehandle given at construction time.
 104
 105 =over
 106
 107 =item ARGUMENTS
 108
 109 =over
 110
 111 =item so_far
 112
 113 Current progress point; this defaults to the current position of the
 114 filehandle. [You probably don't actually want to ever give this.]
 115
 116 =back
 117
 118 =back
 119
 120 =cut
 121
 122 sub update {
 123     my $self = shift;
 124     my $count = $self->__determine_count();
 125     $self->SUPER::update(scalar @_? @_ : $count);
 126 }
 127
 128 sub __determine_max {
 129     my $self = shift;
 130     # is this an IO::Uncompress handle?
 131     my $max = 0;
 132     if ($self->{__filehandle}->can('getHeaderInfo')) {
 133         $self->{__filehandle} = *$self->{__filehandle}{FH};
 134     }
 135     eval {
 136         my $cur_pos = $self->{__filehandle}->tell;
 137         $self->{__filehandle}->seek(0,SEEK_END);
 138         $max = $self->{__filehandle}->tell;
 139         $self->{__filehandle}->seek($cur_pos,SEEK_SET);
 140     };
 141     return $max;
 142 }
 143
 144 sub __determine_count {
 145     my $self = shift;
 146     my $count = 0;
 147     eval {
 148         $count = $self->{__filehandle}->tell;
 149     };
 150     return $count;
 151 }
 152
 153 1;
 154
 155
 156 __END__
 157
 158
 159
 160
 161
 162