From: John Napiorkowski <jjnapiork@cpan.org>
Date: Wed, 23 Oct 2013 17:13:37 +0000 (-0500)
Subject: debugging output
X-Git-Tag: 5.90050~1^2~20
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=e72a3cd6e12d8b9594dcfdddf13c1fbabdffb900

debugging output
---

diff --git a/lib/Catalyst/ActionRole/ConsumesContent.pm b/lib/Catalyst/ActionRole/ConsumesContent.pm
index 0766925..4d15ac2 100644
--- a/lib/Catalyst/ActionRole/ConsumesContent.pm
+++ b/lib/Catalyst/ActionRole/ConsumesContent.pm
@@ -9,7 +9,6 @@ has allowed_content_types => (
   required=>1,
   lazy=>1,
   isa=>'ArrayRef',
-  auto_deref=>1,
   builder=>'_build_allowed_content_types');
 
 has normalized => (
@@ -36,14 +35,16 @@ sub _build_normalized {
 
 sub _build_allowed_content_types {
     my $self = shift;
-    my @proto = split ',', @{$self->attributes->{Consumes}};
-    return map {
+    my @proto = map {split ',', $_ } @{$self->attributes->{Consumes}};
+    my @converted = map {
       if(my $normalized = $self->normalized->{$_}) {
         ref $normalized ? @$normalized : ($normalized);
       } else {
         $_;
       }
     } @proto;
+
+    return \@converted;
 }
 
 around ['match','match_captures'] => sub {
@@ -57,10 +58,18 @@ around ['match','match_captures'] => sub {
 sub can_consume {
     my ($self, $request_content_type) = @_;
     my @matches = grep { lc($_) eq lc($request_content_type) }
-      $self->allowed_content_types;
+      @{$self->allowed_content_types};
     return @matches ? 1:0;
 }
 
+around 'list_extra_info' => sub {
+  my ($orig, $self, @args) = @_;
+  return {
+    %{ $self->$orig(@args) }, 
+    CONSUMES => $self->allowed_content_types,
+  };
+};
+
 1;
 
 =head1 NAME
diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 33e23d2..05fc514 100644
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -101,6 +101,7 @@ sub list {
         my @parents = ();
         my $parent = "DUMMY";
         my $extra  = $self->_list_extra_http_methods($endpoint);
+        my $consumes = $self->_list_extra_consumes($endpoint);
         my $curr = $endpoint;
         while ($curr) {
             if (my $cap = $curr->list_extra_info->{CaptureArgs}) {
@@ -129,12 +130,16 @@ sub list {
             if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) {
                 $name .= ' ('.$cap.')';
             }
+            if (defined(my $ct = $p->list_extra_info->{Consumes})) {
+                $name .= ' :'.$ct;
+            }
+
             unless ($p eq $parents[0]) {
                 $name = "-> ${name}";
             }
             push(@rows, [ '', $name ]);
         }
-        push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}" ]);
+        push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]);
         $rows[0][0] = join('/', '', @parts) || '/';
         $paths->row(@$_) for @rows;
     }
@@ -148,8 +153,16 @@ sub _list_extra_http_methods {
     my ( $self, $action ) = @_;
     return unless defined $action->list_extra_info->{HTTP_METHODS};
     return join(', ', @{$action->list_extra_info->{HTTP_METHODS}});
+
 }
 
+sub _list_extra_consumes {
+    my ( $self, $action ) = @_;
+    return unless defined $action->list_extra_info->{CONSUMES};
+    return join(', ', @{$action->list_extra_info->{CONSUMES}});
+}
+
+
 =head2 $self->match( $c, $path )
 
 Calls C<recurse_match> to see if a chain matches the C<$path>.