The chained SUPER::add_resources calls are fine, but why are you overriding new if all you do is return $class->SUPER::new()? I suggest replacing your "empty" new methods with comments indicating that new is inherited.

Why are all of your instance variables prefixed with underscore? They are instance variables — of course they are internal — so an underscore prefix is just extra typing for no reason.

Baseline Perl 5 OO is really simple: an object is a reference that has been blessed with a vtable. A vtable is a package stash, which bless looks up from the package name. A method call is performed by looking for that method in the vtable. If found, it is called. If not found, the @ISA array is checked and any packages listed there are searched recursively for the method, which is called if found, otherwise AUTOLOAD is tried similarly. If none of this produces a code reference, a fatal exception is thrown. While calling a method, whatever was used to start the method search is unshifted onto @_.

All the rest is built on those basic mechanisms. These is nothing magic about my $self = shift; at all.

Thanks for the extra tips and advice. The code is a work and progress and still kind of crufty. The new constructors, for example, used to have code in them until I figured out how write the code more cleanly. I just haven't bothered to remove them yet.

Regarding underscores, are you saying that because they are *all* internal, there is no need to bother with the convention of using them?

$PM = "Perl Monk's";
$MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest Vicar";
$nysus = $PM . ' ' . $MCF;
Click here if you love Perl Monks

For instance variables, that is, the keys in the blessed anonymous hash that you are using to store your instance data, a leading underscore more usefully indicates "private from subclasses" since all of an object's implementation is supposed to be encapsulated behind methods. So there is a convention, but it is a different convention from method names, where the leading underscore indicates that a method is not part of the external API.

This is the entire FileCollector base class, btw. I got sick of dealing with the headaches and complexities of tracking individual files and paths and directories. This takes all those headaches away. Basically, the FileCollector scoops up all the files and directories you send it with new and add_resources. Then I use children classes to perform operations on and filter and categorize the files. If it's not reinventing the wheel, I may submit it to CPAN.

package Dondley::WestfieldVote::FileCollector ;
use strict; use warnings;

use Cwd;
use Carp;
use File::Basename;
use Log::Log4perl::Shortcuts qw(:all);

{
  my $iterator;
  sub _file_iterator {
    my @files = @_;
    my $f = sub {
      shift @files;
    };
    return $f;
  }

  sub get_next_file {
    my $s = shift;

    if (!$s->{_selected_file}) {
      my @files = @_ ? @_ : $s->get_files;
      $iterator = _file_iterator(@files) if !$iterator;
    }
    my $next_file = $iterator->();
    $s->{_selected_file} = $next_file;
    $iterator = '' if !$next_file;
    return $next_file;
  }
}

sub AUTOLOAD {
  our $AUTOLOAD;
  my $s = shift;
  $AUTOLOAD  =~ /.*::get(_next)*(_\w+)_files*$/ or
    croak "No such method: $AUTOLOAD";
  my ($next, $type) = ($1, $2);
  my $attr = "${type}_files";
  my @files = @{$s->{$attr}};
  return if !@files || !$next;
  return $s->get_next_file(@files);
}

sub new {
  my $class = shift;

  my $s = bless { _files => {},
                  _target_repo   => '',
                  _selected_file => '',
                  _common_dir    => ''}, $class;
  $s->add_resources(@_);
  return $s;
}

sub get_count {
  my $s = shift;
  return (scalar keys %{$s->{_files}})
}

sub get_obj_prop {
  my $s    = shift;
  my $obj  = shift;
  my $prop = shift;

  if (!$prop || !$obj) {
    $s->croak ("Missing arguments to get_obj_prop method"
      . ' at ' .  (caller(0))[1] . ', line ' . (caller(0))[2] );
  }

  my $file = $s->{_selected_file};

  my $o = $obj . '_obj';
  my $object = $s->{_files}{$file}{$o};
  my $attr = "_$prop";
  if (! exists $object->{$attr} ) {
    $s->croak ("Non-existent $obj object attribute requested: '$prop'"
      . ' at ' .  (caller(0))[1] . ', line ' . (caller(0))[2] );
  }
  my $value = $object->{$attr};
  if (ref $value eq 'ARRAY') {
    return @$value;
  } else {
    return $value;
  }
}

sub set_obj_prop {
  my $s = shift;
  my $obj  = shift;
  my $prop = shift;
  my $val  = shift;

  if (!$prop || !$obj) {
    $s->croak ("Missing arguments to get_obj_prop method"
      . ' at ' .  (caller(0))[1] . ', line ' . (caller(0))[2] );
  }

  my $file = $s->{_selected_file};

  my $o = $obj . '_obj';
  my $object = $s->{_files}{$file}{$o};
  my $attr = "_$prop";
  if (! exists $object->{$attr} ) {
    $s->croak ("Non-existent $obj object attribute requested: '$prop'"
      . ' at ' .  (caller(0))[1] . ', line ' . (caller(0))[2] );
  }

  $object->{$attr} = $val;
}

sub add_obj {
  my ($s, $type, $obj)     = @_;
  my $file                 = $s->{_selected_file};
  my $ot                   = "${type}_obj";
  $s->{_files}{$file}{$ot} = $obj;
}

sub selected_file {
  my $s = shift;
  return $s->{_selected_file};
}

sub has_obj {
  my $s = shift;
  my $type = shift;

  if (!$type) {
    $s->croak ("Missing argument to has method"
      . ' at ' .  (caller(0))[1] . ', line ' . (caller(0))[2] );
  }
  my $file = shift || $s->{_selected_file};
  my $to = "${type}_obj";
  return defined $s->{_files}{$file}{$to};
}

sub get_files {
  my $s = shift;

  my @files = sort keys %{$s->{_files}};
  return @files;
}

sub add_resources {
  my ($s, @resources) = @_;

  foreach my $resource (@resources) {
    _exists($resource);
    $s->_add_file($resource)          if -f $resource;
    $s->_get_file_manifest($resource) if -d $resource;
  }

  $s->_generate_short_names;
}

sub list_files_long {
  my $s = shift;

  my @files = $s->get_files;
  print $_ . "\n" for @files;
}

sub list_files {
  my $s = shift;

  my @files = map { $s->{_files}{$_}{short_path} } keys %{$s->{_files}
+};
  print "\nFiles found in '".$s->{_common_dir}."':\n\n";
  print $_ . "\n" for @files;
}

sub print_short_name {
  my $s = shift;
  print $s->short_name . "\n";
}

sub short_name {
  my $s = shift;
  my $file = $s->{_selected_file};
  $s->{_files}{$file}{short_path};
}

sub _generate_short_names {
  my $s = shift;

  my @files                         = $s->get_files;
  my $file                          = pop @files;
  my @comps                         = split /\//, $file;
  my ($new_string, $longest_string) = '';
  foreach my $cfile (@files) {
    my @ccomps = split /\//, $cfile;
    my $lc     = 0;

    foreach my $comp (@ccomps) {
      if (defined $comps[$lc] && $ccomps[$lc] eq $comps[$lc]) {
        $new_string   .= $ccomps[$lc++] . '/';
        next;
      }
      $longest_string = $new_string;
      @comps          = split /\//, $new_string;
      $new_string     = '';
      last;
    }
  }

  $s->{_common_dir} = $longest_string || (fileparse($file))[1];

  if (@files) {
    foreach my $file ( @files, $file ) {
      $s->{_files}{$file}{short_path} = $file =~ s/$longest_string//r;
    }
  } else {
    $s->{_files}{$file}{short_path} = $file;
  }
}

sub get_filename {
  my $s = shift;
  my $file = $s->{_selected_file} || shift;

  return $s->{_files}{$file}{filename};
}

sub _add_file {
  my ($s, $file) = @_;

  $file = $s->_make_absolute($file);
  $s->{_files}{$file}{full_path} = $file;
  my $filename = (fileparse($file))[0];
  $s->{_files}{$file}{filename} = $filename;
}

sub _make_absolute {
  my ($s, $file) = @_;

  return $file =~ /^\// ? $file : cwd() . "/$file";
}

sub _get_file_manifest {
  my ($s, $dir) = @_;

  opendir (my $dh, $dir) or die "Can't opendir $dir: $!";
  my @dirs_and_files = grep { /^[^\.]/ } readdir($dh);

  my @files = grep { -f "$dir/$_" } @dirs_and_files;
  $s->_add_file("$dir/$_") for @files;

  my @dirs  = grep { -d "$dir/$_" } @dirs_and_files;
  foreach my $tdir (@dirs) {
    opendir (my $tdh, "$dir/$tdir") || die "Can't opendir $tdir: $!";
    $s->_get_file_manifest("$dir/$tdir");
  }

}

sub _exists {
  croak "'$_[0]' does not exist. Aborting." if ! -e $_[0];
}

sub _croak {
  my $msg = shift;
  croak $msg . ' at ' . (caller(1))[1] . ', line ' . (caller(1))[2];
}

sub DESTROY {
}

1; # Magic true value
[download]

I will go through this a little bit at a time.

line 1

Maybe File::Collector for CPAN?

lines 9 .. 31

This is the iterator that is giving you trouble and I suggested a replacement earlier.

lines 33 .. 43

This AUTOLOAD method seems to be a way to effectively provide iterator methods for an open set of file categories. Neat, but potentially troublesome because you do not seem to actually have separate iterators for each category. Calling ->get_next_good_header_file and ->get_next_bad_header_file will step on each other.

lines 61 .. 107

At first, I was going to ask why you were reinventing Perl's own instance variable storage, but then I saw that the get_obj_prop and set_obj_prop methods are actually checking objects indexed in the files you are reading. I need to mention that croak is just a function you import from Carp, not an instance method, and the whole purpose of Carp is to take care of the caller tricks for you. You might also be able to simplify these methods by making the %{$s->{_files}{$file}{$o}} hashes restricted hashes, see Hash::Util for details.

lines 119 .. 122

The selected_file method is simple enough that you can dispense with the lexical: sub selected_file { (shift)->{_selected_file} } Whether you want to actually do this is matter of style.

lines 238 .. 251

If portability is a concern, you should probably be using File::Spec here.

And lastly, I present a trick I just figured out and used in some of my own code: (not fully tested yet)

...
sub new {
  # whatever new actually does
  {our $_total_constructed; $_total_constructed++}
  # return object
}
...
sub DESTROY { our $_total_destroyed; $_total_destroyed++ }
[download]

The test suite is then able to ensure that no references have leaked by simply comparing the $_total_constructed and $_total_destroyed package variables.

Thanks again. Yeah, I realize the iterators will stomp on one another. It hasn't been a problem but it's definitely sloppy. Maybe I could set up a hash containing a key for each type of queue. But it might be good enough just to throw an error if the file queue is not empty when a new one is created.

Thanks for the tip on Hash::Util. I was not familiar with restricted hashes. I think the code I currently have to check for an existing property is buggy and it's on my list to test and fix.

Yeah, will definitely use File::Spec if I release this.

$PM = "Perl Monk's";
$MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest Vicar";
$nysus = $PM . ' ' . $MCF;
Click here if you love Perl Monks