Re^3: How to completely destroy class attributes with Test::Most?

[nysus]

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

[jcb]

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++ }

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

[nysus]

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.

[jcb]

For a CPAN release, each category should definitely have an independent iterator. For your own application, throwing an error may be enough.

It might also be better to just return a list of files and let the caller handle iteration with for.