made layoutset name generation smarter, basic tests for name generation

diff --git a/lib/Reaction/UI/View.pm b/lib/Reaction/UI/View.pm
index 358fcf1..f0767f2 100644 (file)
--- a/lib/Reaction/UI/View.pm
+++ b/lib/Reaction/UI/View.pm
@@ -78,21 +78,27 @@ class View which {
 
   implements 'layout_set_for' => as {
     my ($self, $vp) = @_;
-    #print STDERR "Getting layoutset for VP ".(ref($vp) || "SC:".$vp)."\n";
     my $lset_name = eval { $vp->layout };
     confess "Couldn't call layout method on \$vp arg ${vp}: $@" if $@;
-    unless (length($lset_name)) {
-      my $vp_class = ref($vp) || $vp;
-      my ($last) = ($vp_class =~ /.*(?:::ViewPort::)(.+?)$/);
-      my @fragments = split('::', $last);
-      $_ = join("_", split(/(?=[A-Z])/, $_)) for @fragments;
-      $lset_name = lc(join('/', @fragments));
-      #print STDERR "--- $vp_class is rendered as $lset_name\n";
-    }
+    $lset_name = $self->layout_set_name_from_viewport( blessed($vp) )
+      unless (length($lset_name));
     my $cache = $self->_layout_set_cache;
     return $cache->{$lset_name} ||= $self->create_layout_set($lset_name);
   };
 
+  #XXX if it ever comes to it: this could be memoized. not bothering yet.
+  implements 'layout_set_name_from_viewport' => as {
+    my ($self, $class) = @_;
+    my ($last) = ($class =~ /.*(?:::ViewPort::)(.+?)$/);
+    #split when a non-uppercase letter meets an uppercase or when an
+    #uppercase letter is followed by another uppercase and then a non-uppercase
+    #FooBar = foo_bar; Foo_Bar = foo_bar; FOOBar = foo_bar; FooBAR = foo_bar
+    my @fragments = map {
+      join("_", split(/(?:(?<=[A-Z])(?=[A-Z][^_A-Z])|(?<=[^_A-Z])(?=[A-Z]))/, $_))
+    } split('::', $last);
+    return lc(join('/', @fragments));
+  };
+
   implements 'layout_set_file_extension' => as {
     confess View." is abstract, you must subclass it";
   };

diff --git a/t/lib/RTest/UI/View.pm b/t/lib/RTest/UI/View.pm
new file mode 100644 (file)
index 0000000..4450e2d
--- /dev/null
+++ b/t/lib/RTest/UI/View.pm
@@ -0,0 +1,32 @@
+package RTest::UI::View;
+
+use base qw/Reaction::Test/;
+use Reaction::Class;
+use Test::More ();
+use Reaction::UI::View ;
+
+
+#has 'view' => (isa => 'Reaction::UI::View', is => 'ro', lazy_build => 1);
+#view doesn't yet have TCs for this so ican get away with it ...
+#sub _build_view {
+#  Reaction::UI::View->new(
+#                         );
+#}
+
+sub test_layoutset_name_generation :Tests {
+  my $self = shift;
+  my %cases =
+    (
+     'MyApp::ViewPort::FooBar' => 'foo_bar',
+     'Reaction::UI::ViewPort::Foo_Bar' => 'foo_bar',
+     'MyApp::UI::ViewPort::FOOBar::fooBAR' => 'foo_bar/foo_bar',
+     'Reaction::UI::ViewPort::FooBARBaz::FooBAR_' => 'foo_bar_baz/foo_bar_',
+    );
+  while(my($class,$layout) = each %cases ){
+    my $res = Reaction::UI::View->layout_set_name_from_viewport($class);
+    Test::More::is($res,$layout,"layoutset name for $class")
+  }
+
+}
+
+1;

diff --git a/t/lib/RTest/UI/Window.pm b/t/lib/RTest/UI/Window.pm
index 2528f03..0f43ab1 100644 (file)
--- a/t/lib/RTest/UI/Window.pm
+++ b/t/lib/RTest/UI/Window.pm
@@ -33,12 +33,9 @@ use Test::More ();
 use Reaction::UI::Window;
 use aliased 'RTest::UI::Window::_::TestViewPort';
 
-has 'window' => (
-  isa => 'Reaction::UI::Window', is => 'rw',
-  set_or_lazy_build('window')
-);
+has 'window' => (isa => 'Reaction::UI::Window', is => 'rw', lazy_build => 1);
 
-sub build_window {
+sub _build_window {
   my $self = shift;
   return Reaction::UI::Window->new(
            ctx => bless({}, 'Reaction::Test::Mock::Context'),

diff --git a/t/ui_view.t b/t/ui_view.t
new file mode 100644 (file)
index 0000000..e90bc46
--- /dev/null
+++ b/t/ui_view.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use strict;
+use warnings;
+
+use Test::Class;
+use RTest::UI::View;
+
+Test::Class->runtests(
+  RTest::UI::View->new,
+);