add basic support for signatures

mojolicious · Oct 13, 2015 · c6d8a19 · c6d8a19
1 parent be9c197
commit c6d8a19
Show file tree

Hide file tree

Showing 5 changed files with 29 additions and 10 deletions.
diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm
@@ -88,6 +88,12 @@ sub import {
   # Mojo modules are strict!
   $_->import for qw(strict warnings utf8);
   feature->import(':5.10');
+
+  # Signatures for Perl 5.20+
+  if ($] >= 5.020) {
+    feature->import('signatures');
+    warnings->unimport('experimental::signatures');
+  }
 }
 
 sub new {
@@ -150,13 +156,15 @@ All three forms save a lot of typing.
   use warnings;
   use utf8;
   use feature ':5.10';
+  use if $] >= 5.020, experimental => 'signatures';
   use IO::Handle ();
 
   # use Mojo::Base -base;
   use strict;
   use warnings;
   use utf8;
   use feature ':5.10';
+  use if $] >= 5.020, experimental => 'signatures';
   use IO::Handle ();
   use Mojo::Base;
   push @ISA, 'Mojo::Base';
@@ -167,6 +175,7 @@ All three forms save a lot of typing.
   use warnings;
   use utf8;
   use feature ':5.10';
+  use if $] >= 5.020, experimental => 'signatures';
   use IO::Handle ();
   require SomeBaseClass;
   push @ISA, 'SomeBaseClass';

diff --git a/lib/Mojo/JSON.pm b/lib/Mojo/JSON.pm
@@ -6,7 +6,7 @@ use Carp 'croak';
 use Exporter 'import';
 use JSON::PP ();
 use Mojo::Util;
-use Scalar::Util 'blessed';
+use Scalar::Util qw(blessed set_prototype);
 
 our @EXPORT_OK = qw(decode_json encode_json false from_json j to_json true);
 
@@ -33,7 +33,8 @@ sub decode_json {
 
 sub encode_json { Mojo::Util::encode 'UTF-8', _encode_value(shift) }
 
-sub false () {JSON::PP::false}
+sub false {JSON::PP::false}
+BEGIN { set_prototype \&false, '' }
 
 sub from_json {
   my $err = _decode(\my $value, shift, 1);
@@ -47,7 +48,8 @@ sub j {
 
 sub to_json { _encode_value(shift) }
 
-sub true () {JSON::PP::true}
+sub true {JSON::PP::true}
+BEGIN { set_prototype \&true, '' }
 
 sub _decode {
   my $valueref = shift;

diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm
@@ -10,6 +10,7 @@ use Exporter 'import';
 use IO::Poll qw(POLLIN POLLPRI);
 use List::Util 'min';
 use MIME::Base64 qw(decode_base64 encode_base64);
+use Scalar::Util 'set_prototype';
 use Symbol 'delete_package';
 use Time::HiRes ();
 
@@ -259,11 +260,12 @@ sub squish {
   return $str;
 }
 
-sub steady_time () {
+sub steady_time {
   MONOTONIC
     ? Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC())
     : Time::HiRes::time;
 }
+BEGIN { set_prototype \&steady_time, '' }
 
 sub tablify {
   my $rows = shift;

diff --git a/lib/Mojolicious/Lite.pm b/lib/Mojolicious/Lite.pm
@@ -6,6 +6,7 @@ use File::Basename qw(basename dirname);
 use File::Spec::Functions 'catdir';
 use Mojo::UserAgent::Server;
 use Mojo::Util 'monkey_patch';
+use Scalar::Util 'set_prototype';
 
 sub import {
 
@@ -38,11 +39,13 @@ sub import {
   monkey_patch $caller, $_, sub {$app}
     for qw(new app);
   monkey_patch $caller, del => sub { $routes->delete(@_) };
-  monkey_patch $caller, group => sub (&) {
-    (my $old, $root) = ($root, $routes);
-    shift->();
-    ($routes, $root) = ($root, $old);
-  };
+  monkey_patch $caller, group => set_prototype(
+    sub {
+      (my $old, $root) = ($root, $routes);
+      shift->();
+      ($routes, $root) = ($root, $old);
+    } => '&'
+  );
   monkey_patch $caller,
     helper => sub { $app->helper(@_) },
     hook   => sub { $app->hook(@_) },

diff --git a/lib/ojo.pm b/lib/ojo.pm
@@ -7,6 +7,7 @@ use Mojo::Collection 'c';
 use Mojo::DOM;
 use Mojo::JSON 'j';
 use Mojo::Util qw(dumper monkey_patch);
+use Scalar::Util 'set_prototype';
 
 # Silent one-liners
 $ENV{MOJO_LOG_LEVEL} ||= 'fatal';
@@ -31,7 +32,7 @@ sub import {
     g => sub { _request($ua, 'GET',    @_) },
     h => sub { _request($ua, 'HEAD',   @_) },
     j => \&j,
-    n => sub (&@) { say STDERR timestr timeit($_[1] // 1, $_[0]) },
+    n => set_prototype(\&_n, '&@'),
     o => sub { _request($ua, 'OPTIONS', @_) },
     p => sub { _request($ua, 'POST',    @_) },
     r => \&dumper,
@@ -40,6 +41,8 @@ sub import {
     x => sub { Mojo::DOM->new(@_) };
 }
 
+sub _n { say STDERR timestr timeit($_[1] // 1, $_[0]) }
+
 sub _request {
   my $ua = shift;