initial implementation

3 files changed, 201 insertions, 1 deletions

diff --git a/lib/MooseX/Module/Refresh.pm b/lib/MooseX/Module/Refresh.pm
index ce42ead..d8a77a5 100644
--- a/lib/MooseX/Module/Refresh.pm
+++ b/lib/MooseX/Module/Refresh.pm
@@ -1,6 +1,8 @@
 package MooseX::Module::Refresh;
 use Moose;
 
+extends 'Module::Refresh';
+
 =head1 NAME
 
 MooseX::Module::Refresh -
@@ -13,7 +15,49 @@ MooseX::Module::Refresh -
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
+sub _pm_file_to_mod {
+    my ($file) = @_;
+    $file =~ s{\.pm$}{};
+    $file =~ s{/}{::}g;
+    return $file;
+}
+
+after unload_module => sub {
+    my $self = shift;
+    my $mod = _pm_file_to_mod($_[0]);
+    my $meta = Class::MOP::class_of($mod);
+    return unless defined $meta;
+    return unless $meta->isa('Moose::Meta::Class');
+    if ($meta->is_immutable) {
+        warn "Can't modify an immutable class";
+        return;
+    }
+    $self->unload_methods($meta);
+    $self->unload_attrs($meta);
+    # XXX: this is probably wrong, but...
+    $meta->superclasses('Moose::Object');
+    bless $meta, 'Moose::Meta::Class';
+    # XXX: why is this breaking
+    #for my $attr ($meta->meta->get_all_attributes) {
+        #$attr->set_value($meta, $attr->default($meta));
+    #}
+};
+
+sub unload_methods {
+    my $self = shift;
+    my ($meta) = @_;
+    for my $meth ($meta->get_method_list) {
+        $meta->remove_method($meth)
+            unless exists $DB::sub{$meta->name . "::$meth"};
+    }
+}
+
+sub unload_attrs {
+    my $self = shift;
+    my ($meta) = @_;
+    $meta->remove_attribute($_) for $meta->get_attribute_list;
+}
+
 no Moose;
 
 =head1 BUGS
diff --git a/t/001-basic.t b/t/001-basic.t
new file mode 100644
index 0000000..05984d5
--- /dev/null
+++ b/t/001-basic.t
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+use MooseX::Module::Refresh;
+
+use File::Temp 'tempdir';
+my $tmp = tempdir( CLEANUP => 1 );
+
+my $file = $tmp."/".'FooBar.pm';
+push @INC, $tmp;
+
+write_out(<<".");
+package Foo::Bar;
+sub foo { 'bar' }
+1;
+.
+
+use_ok('FooBar', "Required our dummy module");
+
+my $r = MooseX::Module::Refresh->new();
+
+# is our non-file-based method available?
+
+can_ok('Foo::Bar', 'not_in_foobarpm');
+
+is(Foo::Bar->foo, 'bar', "We got the right result");
+
+write_out(<<".");
+package Foo::Bar; 
+sub foo { 'baz' }
+1;
+.
+
+is(Foo::Bar->foo, 'bar', "We got the right result, still");
+
+$r->refresh;
+
+is(Foo::Bar->foo, 'baz', "We got the right new result,");
+
+# After a refresh, did we blow away our non-file-based comp?
+can_ok('Foo::Bar', 'not_in_foobarpm');
+
+$r->unload_subs($file);
+ok(!defined(&Foo::Bar::foo), "We cleaned out the 'foo' method'");
+
+#ok(!UNIVERSAL::can('Foo::Bar', 'foo'), "We cleaned out the 'foo' method'");
+#require "FooBar.pm";
+#is(Foo::Bar->foo, 'baz', "We got the right new result,");
+
+sub write_out {
+    local *FH;
+    open FH, "> $file" or die "Cannot open $file: $!";
+    print FH $_[0];
+    close FH;
+}
+
+END {
+    unlink $file;
+}
+
+
+package Foo::Bar;
+
+sub not_in_foobarpm {
+    return "woo";
+}
+
+1;
diff --git a/t/002-moose.t b/t/002-moose.t
new file mode 100644
index 0000000..9141eda
--- /dev/null
+++ b/t/002-moose.t
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 14;
+
+use MooseX::Module::Refresh;
+
+use File::Temp 'tempdir';
+my $tmp = tempdir( CLEANUP => 1 );
+
+my $file = $tmp."/".'FooBar.pm';
+push @INC, $tmp;
+
+write_out(<<".");
+package FooBar;
+use Moose;
+has foo => (is => 'ro', clearer => 'clear_foo');
+sub bar { 'bar' }
+1;
+.
+
+use_ok('FooBar', "Required our dummy module");
+
+my $r = MooseX::Module::Refresh->new();
+
+# is our non-file-based method available?
+
+can_ok('FooBar', 'not_in_foobarpm');
+
+can_ok('FooBar', 'new');
+my $foobar = FooBar->new(foo => 'FOO');
+is($foobar->bar, 'bar', "We got the right result");
+is($foobar->foo, 'FOO', "We got the right result");
+can_ok($foobar, 'clear_foo');
+
+write_out(<<".");
+package FooBar; 
+has baz => (is => 'ro', predicate => 'foo');
+sub quux { 'baz' }
+1;
+.
+
+$foobar = FooBar->new(foo => 'FOO');
+is($foobar->bar, 'bar', "We got the right result, still");
+is($foobar->foo, 'FOO', "We got the right result, still");
+
+$r->refresh;
+
+$foobar = FooBar->new(baz => 'FOO');
+is($foobar->quux, 'baz', "We got the right new result");
+is($foobar->baz, 'FOO', "We got the right new result");
+is($foobar->foo, 1, "We got the right new result");
+ok(!$foobar->can('bar'), "the bar method was removed");
+ok(!$foobar->can('clear_foo'), "the clear_foo method was removed");
+
+# After a refresh, did we blow away our non-file-based comp?
+can_ok('FooBar', 'not_in_foobarpm');
+
+# XXX: figure out what to do about unload_subs
+#$r->unload_subs($file);
+#ok(!defined(&FooBar::foo), "We cleaned out the 'foo' method'");
+
+#ok(!UNIVERSAL::can('FooBar', 'foo'), "We cleaned out the 'foo' method'");
+#require "FooBar.pm";
+#is(FooBar->foo, 'baz', "We got the right new result,");
+
+sub write_out {
+    local *FH;
+    open FH, "> $file" or die "Cannot open $file: $!";
+    print FH $_[0];
+    close FH;
+}
+
+END {
+    unlink $file;
+}
+
+
+package FooBar;
+use Moose;
+
+sub not_in_foobarpm {
+    return "woo";
+}
+
+1;