Re: [Module-build-general] [PATCH] - really fix add_to_cleanup

[Ken W. <ke...@ma...>]

Hey,

I don't much like the idea of the tests reading the 'cleanup' file - 
first because that should basically be considered private data, not 
part of the interface, and second because the caller shouldn't really 
care whether it's on disk or not, just whether it "works right".

The current design is that the list of cleanup files is written to disk 
at the soonest possible moment, which means whenever add_to_cleanup() 
is called and there's a config directory to write into.  Maybe we 
should try to do it even sooner, i.e. whenever add_to_cleanup() *or* 
create_build_script() is called.

The patch I'll apply is appended here.  It uses some new interface 
stuff that I think is useful.  It also changes the add_to_cleanup() 
method yet again, this time for the simpler.  I think the whole system 
is a bit simpler now, actually.

  -Ken


On Thursday, April 24, 2003, at 09:36  AM, Dave Rolsky wrote:

> On Thu, 24 Apr 2003, Dave Rolsky wrote:
>
>> Ken, you changed my patch in a way that broke it.  Unfortunately, my 
>> test
>> case wasn't very good, so it didn't catch it.
>>
>> Here's another patch that fixes this problem again and adds a test 
>> case
>> that actually tests it ;)
>
> Except this broke the XS tests cause it wasn't quite right.  Ok, here 
> it
> is yet again, totally freaking working!
>
>

Index: lib/Module/Build/Base.pm
===================================================================
RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v
retrieving revision 1.95
diff -u -r1.95 Base.pm
--- lib/Module/Build/Base.pm	21 Apr 2003 20:54:40 -0000	1.95
+++ lib/Module/Build/Base.pm	24 Apr 2003 16:19:59 -0000
@@ -1,6 +1,6 @@
  package Module::Build::Base;

-# $Id: Base.pm,v 1.95 2003/04/21 20:54:40 kwilliams Exp $
+# $Id: Base.pm,v 1.96 2003/04/24 15:50:43 kwilliams Exp $

  use strict;
  BEGIN { require 5.00503 }
@@ -292,26 +292,44 @@
    return undef;
  }

-sub add_to_cleanup {
+sub _write_cleanup {
    my $self = shift;
-  my @new_files = grep {!exists $self->{cleanup}{$_}} @_, keys 
%{$self->{add_to_cleanup}};
-  return unless @new_files;
+  my @to_write = keys %{ $self->{add_to_cleanup} }
+    or return;
+
+  my $file = $self->config_file('cleanup');
+  my $fh = IO::File->new(">> $file") or die "Can't write to $file: $!";
+  print $fh "$_\n" foreach @to_write;
+  close $fh;

-  if ( my $file = $self->config_file('cleanup') ) {
-    # A state file exists on disk, so we don't need to save in memory
+  @{ $self->{cleanup} }{ @to_write } = ();
+  $self->{add_to_cleanup} = {};
+}

-    my $fh = IO::File->new(">> $file") or die "Can't append to $file: 
$!";
-    print $fh "$_\n" foreach @new_files;
-    delete $self->{add_to_cleanup};
-
-  } else {
-    # No state file is being used.  Maybe it will later, but for now
-    # just save in memory.
+sub cleanup_is_flushed {
+  my $self = shift;
+  return ! keys %{ $self->{add_to_cleanup} };
+}

-    @{$self->{add_to_cleanup}}{ @new_files } = ();
-  }
+sub add_to_cleanup {
+  my $self = shift;
+
+  # $self->{cleanup} contains files that are already written in the
+  # 'cleanup' file.  $self->{add_to_cleanup} is a buffer that we
+  # haven't written yet (and may never write if we don't ever create
+  # the cleanup file).
+
+  my @new_files = grep {!exists $self->{cleanup}{$_}} @_
+    or return;
+
+  @{$self->{add_to_cleanup}}{ @new_files } = ();

-  @{$self->{cleanup}}{ @new_files } = ();
+  $self->_write_cleanup if $self->config_file('cleanup');
+}
+
+sub cleanup {
+  my $self = shift;
+  return (keys %{$self->{cleanup}}, keys %{$self->{add_to_cleanup}});
  }

  sub config_file {
@@ -358,6 +376,8 @@
    my @items = qw(requires build_requires conflicts recommends);
    print $fh Data::Dumper::Dumper( { map {$_,$self->{properties}{$_}} 
@items } );
    close $fh;
+
+  $self->_write_cleanup;
  }

  sub prereq_failures {
@@ -953,7 +973,7 @@

  sub ACTION_clean {
    my ($self) = @_;
-  foreach my $item (keys %{$self->{cleanup}}) {
+  foreach my $item ($self->cleanup) {
      $self->delete_filetree($item);
    }
  }
Index: t/runthrough.t
===================================================================
RCS file: /cvsroot/module-build/Module-Build/t/runthrough.t,v
retrieving revision 1.15
diff -u -r1.15 runthrough.t
--- t/runthrough.t	21 Apr 2003 19:44:04 -0000	1.15
+++ t/runthrough.t	24 Apr 2003 16:19:59 -0000
@@ -1,5 +1,5 @@
  use Test;
-BEGIN { plan tests => 14 }
+BEGIN { plan tests => 17 }
  use Module::Build;
  use File::Spec;
  use File::Path;
@@ -23,14 +23,22 @@
  			       license => 'perl' );
  ok $build;

+# Make sure cleanup files added before create_build_script() get 
respected
  $build->add_to_cleanup('before_script');

  eval {$build->create_build_script};
  ok $@, '';
+ok $build->cleanup_is_flushed;

-ok grep $_ eq 'before_script', keys %{$build->{cleanup}};
+# The 'cleanup' file doesn't exist yet
+ok grep $_ eq 'before_script', $build->cleanup;

  $build->add_to_cleanup('save_out');
+
+# The 'cleanup' file now exists
+ok grep $_ eq 'before_script', $build->cleanup;
+ok grep $_ eq 'save_out',      $build->cleanup;
+
  my $output = eval {
    stdout_of( sub { $build->dispatch('test', verbose => 1) } )
  };