Debbugs/BugWalker.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later
   3 # version at your option.
   4 # See the file README and COPYING for more information.
   5 #
   6 # Copyright 2014 by Don Armstrong <don@donarmstrong.com>.
   7
   8 package Debbugs::BugWalker;
   9
  10 =head1 NAME
  11
  12 Debbugs::BugWalker -- Walk through all known bugs
  13
  14 =head1 SYNOPSIS
  15
  16     use Debbugs::BugWalker;
  17     my $w = Debbugs::BugWalker->new();
  18
  19 =head1 DESCRIPTION
  20
  21 This module contains routines to walk through all known bugs (and
  22 return specific files or bug numbers).
  23
  24 =head1 BUGS
  25
  26 =head1 FUNCTIONS
  27
  28 =cut
  29
  30 use warnings;
  31 use strict;
  32 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  33 use base qw(Exporter);
  34
  35 BEGIN{
  36      $VERSION = 1.00;
  37      $DEBUG = 0 unless defined $DEBUG;
  38
  39      @EXPORT = ();
  40      %EXPORT_TAGS = ();
  41      @EXPORT_OK = ();
  42      $EXPORT_TAGS{all} = [@EXPORT_OK];
  43 }
  44
  45 use Debbugs::Config qw(:config);
  46 use Debbugs::Common qw(make_list);
  47 use Moo;
  48 use IO::File;
  49 use IO::Dir;
  50
  51 =head1 Functions
  52
  53 =over
  54
  55 =item C<Debbugs::BugWalker-E<gt>new()>
  56
  57 Create a new bugwalker object to walk through available bugs.
  58
  59 Takes the following options
  60
  61 =over
  62
  63 =item progress
  64
  65 L<Term::ProgressBar> to update progress on a terminal dynamically
  66 (optional)
  67
  68 =cut
  69
  70 has progress =>
  71     (is => 'ro',
  72      isa => sub {
  73          if (not defined $_[0] or
  74              $_[0]->can('update')
  75             ) {
  76              die "Progress must support ->update";
  77          }
  78      }
  79     );
  80
  81 =item dirs
  82
  83 Directories to use to search for bugs; defaults to
  84 C<$config{spool_dir}>
  85
  86 =cut
  87
  88 has dirs =>
  89     (is => 'ro',
  90     );
  91
  92 =item what
  93
  94 What files/directories to return. Defaults to bug, but must be one of
  95 summary, bug, log, or status.
  96
  97 =cut
  98
  99 has what =>
 100     (is => 'ro',
 101      isa => sub {
 102          die "Must be one of summary, bug, log, status, version, or debinfo"
 103              unless $_[0] =~ /^(?:summary|bug|log|status|version|debinfo)$/;
 104      });
 105
 106
 107 =back
 108
 109 =back
 110
 111 =cut
 112
 113 sub get_next {
 114     my ($self) = @_;
 115
 116     if (not defined $self->{_dirs}) {
 117         $self->{_dirs} = [make_list($self->dirs())];
 118         $self->{_done_dirs} = 0;
 119         $self->{_done_files} = 0;
 120         $self->{_avg_subfiles} = 0;
 121     }
 122     if (not defined $self->{_files}) {
 123         $self->{_files} = [];
 124     }
 125     while (not @{$self->{_files}}) {
 126         my $next_dir = shift @{$self->{_dirs}};
 127         my $nd = IO::Dir->new($next_dir) or
 128             die "Unable to open $next_dir for reading: $!";
 129         my $f;
 130         while (defined ($f = $nd->read)) {
 131             my $fn = File::Spec->catfile($next_dir,$f);
 132             if (-d $fn) {
 133                 push @{$self->{_dirs}},$fn;
 134                 $self->{_total_dirs}++;
 135             } elsif (-r _) {
 136                 if ($self->{what} eq 'bug') {
 137                     next unless $fn =~ /(\d+)\.status$/;
 138                     push @{$self->{_files}}, $1;
 139                 } else {
 140                     next unless $fn =~ /\.$self->{what}$/;
 141                     push @{$self->{_files}}, $fn;
 142                 }
 143             }
 144         }
 145         if (defined $self->progress) {
 146             $self->progress->target($self->{_avg_subfiles}*$self->{_dirs}+
 147                                     $self->{_done_files}+@{$self->{_files}});
 148             $self->{_avg_subfiles} =
 149                 ($self->{_avg_subfiles}*$self->{_done_dirs}+@{$self->{_files}})/
 150                 ($self->{_done_dirs}+1);
 151         }
 152         $self->{_done_dirs}++;
 153     }
 154     if (@{$self->{_files}}) {
 155         $self->progress->update($self->{done_files}++);
 156         return shift @{$self->{_files}};
 157     }
 158     return undef;
 159 }
 160
 161
 162 1;
 163
 164 __END__