From: Hakim Cassimally <hakim@doesliverpool.com>
Date: Thu, 15 May 2014 13:37:05 +0000 (+0000)
Subject: Web::Simple::Role
X-Git-Tag: v0.021~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FWeb-Simple.git;a=commitdiff_plain;h=01183e70e79f10598e5949180bc876e17251f0ed

Web::Simple::Role
---

diff --git a/lib/Web/Simple/Role.pm b/lib/Web/Simple/Role.pm
new file mode 100644
index 0000000..b6cd35f
--- /dev/null
+++ b/lib/Web/Simple/Role.pm
@@ -0,0 +1,54 @@
+package Web::Simple::Role;
+
+=head1 NAME
+
+Web::Simple::Role
+
+=head1 SYNOPSIS
+
+  package MyApp;
+  use Web::Simple;
+  with MyApp::Role;
+  
+  sub dispatch_request { ... }
+
+and in the role:
+
+  package MyApp::Role;
+  use Web::Simple::Role;
+
+  around dispatch_request => sub {
+    my ($orig, $self) = @_;
+    return (
+      $self->$orig,
+      sub (GET + /baz) { ... }
+    );
+  };
+
+Now C<MyApp> can also dispatch C</baz>
+
+=cut
+
+use strictures 1;
+use 5.008;
+use warnings::illegalproto ();
+use Moo::Role ();
+
+our $VERSION = '0.020';
+
+sub import {
+  my ($class, $app_package) = @_;
+  $app_package ||= caller;
+  eval "package $app_package; use Web::Dispatch::Wrapper; use Moo::Role; 1"
+    or die "Failed to setup app package: $@";
+  strictures->import;
+  warnings::illegalproto->unimport;
+}
+
+=head1 AUTHOR
+
+osfameron@cpan.org
+
+=cut
+
+1;
diff --git a/t/role.t b/t/role.t
new file mode 100644
index 0000000..6da5181
--- /dev/null
+++ b/t/role.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+{
+  package BazRole;
+  use Web::Simple::Role;
+
+  around dispatch_request => sub {
+    my ($orig, $self) = @_;
+    return (
+      $self->$orig,
+      sub (GET + /baz) {
+        [ 200,
+          [ "Content-type" => "text/plain" ],
+          [ 'baz' ],
+        ]
+      }
+    );
+  };
+}
+{
+  package FooBar;
+  use Web::Simple;
+  with 'BazRole';
+  sub dispatch_request {
+    sub (GET + /foo) {
+      [ 200,
+        [ "Content-type" => "text/plain" ],
+        [ 'foo' ],
+      ]
+    },
+    sub (GET + /bar) {
+      [ 200,
+        [ "Content-type" => "text/plain" ],
+        [ 'bar' ],
+      ]
+    },
+  }
+}
+
+use HTTP::Request::Common qw(GET POST);
+
+my $app = FooBar->new;
+sub run_request { $app->run_test_request(@_); }
+
+for my $word (qw/ foo bar baz /) {
+  my $get = run_request(GET "http://localhost/${word}");
+  is($get->content, $word, "Dispatch $word");
+}
+
+done_testing;