From 3669b3d498f2f6224b8dc8cdc8cfcca1c0165611 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 22 Jun 2011 12:02:03 -0500 Subject: initial implementation --- dist.ini | 2 ++ lib/Plack/Middleware/Class/Refresh.pm | 22 ++++++++++++++++ t/basic.t | 47 +++++++++++++++++++++++++++++++++++ t/data/basic/Baz/Quux.pm | 7 ++++++ t/data/basic/Foo.pm | 7 ++++++ t/data/basic/Foo/Bar.pm | 7 ++++++ t/data_new/basic/Foo.pm | 7 ++++++ t/lib/Test/PMCR.pm | 35 ++++++++++++++++++++++++++ 8 files changed, 134 insertions(+) create mode 100644 t/basic.t create mode 100644 t/data/basic/Baz/Quux.pm create mode 100644 t/data/basic/Foo.pm create mode 100644 t/data/basic/Foo/Bar.pm create mode 100644 t/data_new/basic/Foo.pm create mode 100644 t/lib/Test/PMCR.pm diff --git a/dist.ini b/dist.ini index ab2fe80..b79ea38 100644 --- a/dist.ini +++ b/dist.ini @@ -7,3 +7,5 @@ copyright_holder = Jesse Luehrs dist = Plack-Middleware-Class-Refresh [Prereqs] +Class::Refresh = 0 +Plack = 0 diff --git a/lib/Plack/Middleware/Class/Refresh.pm b/lib/Plack/Middleware/Class/Refresh.pm index e69de29..453e6f1 100644 --- a/lib/Plack/Middleware/Class/Refresh.pm +++ b/lib/Plack/Middleware/Class/Refresh.pm @@ -0,0 +1,22 @@ +package Plack::Middleware::Class::Refresh; +use strict; +use warnings; +use Plack::Util::Accessor 'verbose'; + +use Class::Refresh; + +use base 'Plack::Middleware'; + +sub call { + my $self = shift; + + my @changed = Class::Refresh->modified_modules; + warn "Classes " . join(', ', @changed) . " have been changed, refreshing" + if $self->verbose && @changed; + + Class::Refresh->refresh; + + $self->app->(@_); +} + +1; diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..2373218 --- /dev/null +++ b/t/basic.t @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Plack::Test; +use lib 't/lib'; +use Test::PMCR; + +use File::Copy; +use File::Spec::Functions 'catfile'; +use HTTP::Request::Common; + +use Plack::Middleware::Class::Refresh; + +my $dir = Test::PMCR::setup_temp_dir('basic'); + +require Foo; +require Foo::Bar; +require Baz::Quux; + +my $app = sub { + return [ + 200, + [], + [join "\n", Foo->call, Foo::Bar->call, Baz::Quux->call] + ]; +}; + +test_psgi + app => Plack::Middleware::Class::Refresh->wrap($app), + client => sub { + my $cb = shift; + { + my $res = $cb->(GET 'http://localhost/'); + is($res->code, 200, "right code"); + is($res->content, "Foo\nFoo::Bar\nBaz::Quux"); + } + copy(catfile(qw(t data_new basic Foo.pm)), catfile($dir, 'Foo.pm')) + || die "couldn't copy: $!"; + { + my $res = $cb->(GET 'http://localhost/'); + is($res->code, 200, "right code"); + is($res->content, "FOO\nFoo::Bar\nBaz::Quux"); + } + }; + +done_testing; diff --git a/t/data/basic/Baz/Quux.pm b/t/data/basic/Baz/Quux.pm new file mode 100644 index 0000000..14a0581 --- /dev/null +++ b/t/data/basic/Baz/Quux.pm @@ -0,0 +1,7 @@ +package Baz::Quux; +use strict; +use warnings; + +sub call { __PACKAGE__ } + +1; diff --git a/t/data/basic/Foo.pm b/t/data/basic/Foo.pm new file mode 100644 index 0000000..b817f30 --- /dev/null +++ b/t/data/basic/Foo.pm @@ -0,0 +1,7 @@ +package Foo; +use strict; +use warnings; + +sub call { __PACKAGE__ } + +1; diff --git a/t/data/basic/Foo/Bar.pm b/t/data/basic/Foo/Bar.pm new file mode 100644 index 0000000..1fab089 --- /dev/null +++ b/t/data/basic/Foo/Bar.pm @@ -0,0 +1,7 @@ +package Foo::Bar; +use strict; +use warnings; + +sub call { __PACKAGE__ } + +1; diff --git a/t/data_new/basic/Foo.pm b/t/data_new/basic/Foo.pm new file mode 100644 index 0000000..3685951 --- /dev/null +++ b/t/data_new/basic/Foo.pm @@ -0,0 +1,7 @@ +package Foo; +use strict; +use warnings; + +sub call { uc(__PACKAGE__) } + +1; diff --git a/t/lib/Test/PMCR.pm b/t/lib/Test/PMCR.pm new file mode 100644 index 0000000..c3d930c --- /dev/null +++ b/t/lib/Test/PMCR.pm @@ -0,0 +1,35 @@ +package Test::PMCR; +use strict; +use warnings; + +use File::Copy; +use File::Find; +use File::Spec::Functions 'abs2rel', 'catdir'; +use File::Temp 'tempdir'; + +sub setup_temp_dir { + my ($test) = @_; + + my $dir = tempdir(CLEANUP => 1); + + lib->import($dir); + + my $from_base = catdir(qw(t data), $test); + find(sub { + return if $_ eq '.'; + if (-d) { + my $from = abs2rel($File::Find::name, $from_base); + my $to = catdir($dir, $from); + mkdir($to) || die "couldn't mkdir: $!"; + } + else { + my $from = abs2rel($File::Find::name, $from_base); + my $to = catdir($dir, $from); + copy($_, $to) || die "couldn't copy: $!"; + } + }, $from_base); + + return $dir; +} + +1; -- cgit v1.2.3-54-g00ecf