added support for web linking

mojolicious · Aug 2, 2014 · 06a458e · 06a458e
1 parent 5328a63
commit 06a458e
Show file tree

Hide file tree

Showing 6 changed files with 58 additions and 6 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,9 @@
 
 5.24  2014-08-02
+  - Added links method to Mojo::Message.
+  - Improved split_header function in Mojo::Util to handle more formats with
+    an optional callback.
+  - Fixed bug where ojo would sometimes die silently.
 
 5.23  2014-07-31
   - Improved router performance.

diff --git a/lib/Mojo/Message.pm b/lib/Mojo/Message.pm
@@ -9,7 +9,7 @@ use Mojo::JSON 'j';
 use Mojo::JSON::Pointer;
 use Mojo::Parameters;
 use Mojo::Upload;
-use Mojo::Util 'decode';
+use Mojo::Util qw(decode split_header);
 
 has content => sub { Mojo::Content::Single->new };
 has default_charset  => 'UTF-8';
@@ -139,6 +139,19 @@ sub json {
   return $pointer ? Mojo::JSON::Pointer->new($data)->get($pointer) : $data;
 }
 
+sub links {
+  my $self = shift;
+
+  my %links;
+  my $cb = sub { ${$_[0]} =~ s/^\s*<(.+?)>// ? ($1, undef) : () };
+  for my $link (@{split_header $self->headers->link // '', $cb}) {
+    my $hash = {url => (splice @$link, 0, 2)[0], @$link};
+    $links{$hash->{rel}} = $hash;
+  }
+
+  return \%links;
+}
+
 sub param { shift->body_params->param(@_) }
 
 sub parse {
@@ -578,6 +591,17 @@ sure it is not excessively large, there's a 10MB limit by default.
   say $msg->json->{foo}{bar}[23];
   say $msg->json('/foo/bar/23');
 
+=head2 links
+
+  my $links = $msg->links;
+
+Extract web links from C<Link> header according to
+L<RFC 5988|http://tools.ietf.org/html/rfc5988>.
+
+  # Extract information about next page
+  say $msg->links->{next}{url};
+  say $msg->links->{next}{title};
+
 =head2 param
 
   my @names       = $msg->param;

diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm
@@ -248,9 +248,10 @@ sub slurp {
 }
 
 sub split_header {
-  my $str = shift;
+  my ($str, $cb) = @_;
 
-  my (@tree, @token);
+  my @tree;
+  my @token = $cb ? $cb->(\$str) : ();
   while ($str =~ s/^[,;\s]*([^=;, ]+)\s*//) {
     push @token, $1, undef;
     $token[-1] = unquote($1)
@@ -260,7 +261,7 @@ sub split_header {
     $str =~ s/^;\s*//;
     next unless $str =~ s/^,\s*//;
     push @tree, [@token];
-    @token = ();
+    @token = $cb ? $cb->(\$str) : ();
   }
 
   # Take care of final token
@@ -625,8 +626,10 @@ Read all data at once from file.
 =head2 split_header
 
    my $tree = split_header 'foo="bar baz"; test=123, yada';
+   my $tree = split_header '</foo;bar>; rel=next', sub {...};
 
-Split HTTP header value.
+Split HTTP header value, the optional callback will be invoked at the
+beginning of every new comma separated segment.
 
   # "one"
   split_header('one; two="three four", five=six')->[0][0];
@@ -637,6 +640,12 @@ Split HTTP header value.
   # "five"
   split_header('one; two="three four", five=six')->[1][0];
 
+  # "foo;baz"
+  split_header('<foo;baz>; rel=next', sub {
+    my $strref = shift;
+    return $$strref =~ s/^<.+?>// ? ($1, undef) : ();
+  })->[0][0];
+
 =head2 spurt
 
   $bytes = spurt $bytes, '/etc/passwd';

diff --git a/lib/ojo.pm b/lib/ojo.pm
@@ -14,7 +14,7 @@ sub import {
 
   # Mojolicious::Lite
   my $caller = caller;
-  eval "package $caller; use Mojolicious::Lite;";
+  eval "package $caller; use Mojolicious::Lite; 1" or die $@;
   my $ua = $caller->app->ua;
   $ua->server->app->hook(around_action => sub { local $_ = $_[1]; $_[0]->() });
 

diff --git a/t/mojo/response.t b/t/mojo/response.t
@@ -416,6 +416,8 @@ is $res->headers->content_length, undef, 'right "Content-Length" value';
 $res = Mojo::Message::Response->new;
 $res->parse("HTTP/1.1 500 Internal Server Error\x0d\x0a");
 $res->parse("Content-Type: text/plain\x0d\x0a");
+$res->parse("Link: <http://example.com?foo=b;,ar>; rel=next\x0d\x0a");
+$res->parse(qq{Link: </>; rel=root; title="foo bar"\x0d\x0a});
 $res->parse("Transfer-Encoding: chunked\x0d\x0a\x0d\x0a");
 $res->parse("4\x0d\x0a");
 $res->parse("abcd\x0d\x0a");
@@ -430,6 +432,14 @@ is $res->headers->content_type,   'text/plain', 'right "Content-Type" value';
 is $res->headers->content_length, 13,           'right "Content-Length" value';
 is $res->headers->transfer_encoding, undef, 'no "Transfer-Encoding" value';
 is $res->body_size, 13, 'right size';
+is $res->headers->link,
+  '<http://example.com?foo=b;,ar>; rel=next, </>; rel=root; title="foo bar"',
+  'right "Link" value';
+my $links = {
+  next => {url => 'http://example.com?foo=b;,ar', rel => 'next'},
+  root => {url => '/', rel => 'root', title => 'foo bar'}
+};
+is_deeply $res->links, $links, 'right links';
 
 # Parse HTTP 1.1 multipart response
 $res = Mojo::Message::Response->new;

diff --git a/t/mojo/util.t b/t/mojo/util.t
@@ -81,6 +81,11 @@ $tree   = [
   ]
 ];
 is_deeply split_header($header), $tree, 'right result';
+my $cb = sub { substr(${$_[0]}, 0, 3, ''), undef };
+is_deeply split_header('', $cb), [['', undef]], 'right result';
+$header = q{f;o; bar=baz, b,z; yada="a b c"};
+$tree = [['f;o', undef, 'bar', 'baz'], ['b,z', undef, 'yada', 'a b c']];
+is_deeply split_header($header, $cb), $tree, 'right result';
 
 # unindent
 is unindent(" test\n  123\n 456\n"), "test\n 123\n456\n",