added monkey_patch function to Mojo::Util

mojolicious · Dec 15, 2012 · 607b550 · 607b550
1 parent b4a1007
commit 607b550
Show file tree

Hide file tree

Showing 9 changed files with 86 additions and 68 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
 3.68  2012-12-16
+  - Added monkey_patch function to Mojo::Util.
   - Updated jQuery to version 1.8.3.
   - Improved documentation.
   - Fixed small export bug in Mojolicious::Lite. (jberger)

diff --git a/lib/Mojo/ByteStream.pm b/lib/Mojo/ByteStream.pm
@@ -15,16 +15,13 @@ my @UTILS = (
   qw(punycode_encode quote sha1_bytes sha1_sum slurp spurt squish trim),
   qw(unquote url_escape url_unescape xml_escape xor_encode)
 );
-{
-  no strict 'refs';
-  for my $name (@UTILS) {
-    my $sub = Mojo::Util->can($name);
-    *{__PACKAGE__ . "::$name"} = sub {
-      my $self = shift;
-      $$self = $sub->($$self, @_);
-      return $self;
-    };
-  }
+for my $name (@UTILS) {
+  my $sub = Mojo::Util->can($name);
+  Mojo::Util::monkey_patch __PACKAGE__, $name, sub {
+    my $self = shift;
+    $$self = $sub->($$self, @_);
+    return $self;
+  };
 }
 
 sub new {

diff --git a/lib/Mojo/Headers.pm b/lib/Mojo/Headers.pm
@@ -1,7 +1,7 @@
 package Mojo::Headers;
 use Mojo::Base -base;
 
-use Mojo::Util 'get_line';
+use Mojo::Util qw(get_line monkey_patch);
 
 has max_line_size => sub { $ENV{MOJO_MAX_LINE_SIZE} || 10240 };
 
@@ -16,13 +16,10 @@ my @HEADERS = (
   qw(Sec-WebSocket-Protocol Sec-WebSocket-Version Server Set-Cookie Status),
   qw(TE Trailer Transfer-Encoding Upgrade User-Agent WWW-Authenticate)
 );
-{
-  no strict 'refs';
-  for my $header (@HEADERS) {
-    my $name = lc $header;
-    $name =~ s/-/_/g;
-    *{__PACKAGE__ . "::$name"} = sub { scalar shift->header($header => @_) };
-  }
+for my $header (@HEADERS) {
+  my $name = lc $header;
+  $name =~ s/-/_/g;
+  monkey_patch __PACKAGE__, $name, sub { scalar shift->header($header => @_) };
 }
 
 # Lower case headers

diff --git a/lib/Mojo/Template.pm b/lib/Mojo/Template.pm
@@ -4,7 +4,7 @@ use Mojo::Base -base;
 use Carp 'croak';
 use Mojo::ByteStream;
 use Mojo::Exception;
-use Mojo::Util qw(decode encode slurp);
+use Mojo::Util qw(decode encode monkey_patch slurp);
 
 use constant DEBUG => $ENV{MOJO_TEMPLATE_DEBUG} || 0;
 
@@ -309,10 +309,8 @@ sub _wrap {
   my ($self, $lines) = @_;
 
   # Escape function
-  no strict 'refs';
-  no warnings 'redefine';
   my $escape = $self->escape;
-  *{$self->namespace . '::_escape'} = sub {
+  monkey_patch $self->namespace, '_escape', sub {
     no warnings 'uninitialized';
     ref $_[0] eq 'Mojo::ByteStream' ? $_[0] : $escape->("$_[0]");
   };

diff --git a/lib/Mojo/UserAgent.pm b/lib/Mojo/UserAgent.pm
@@ -8,6 +8,7 @@ use List::Util 'first';
 use Mojo::IOLoop;
 use Mojo::Server::Daemon;
 use Mojo::URL;
+use Mojo::Util 'monkey_patch';
 use Mojo::UserAgent::CookieJar;
 use Mojo::UserAgent::Transactor;
 use Scalar::Util 'weaken';
@@ -29,15 +30,12 @@ has request_timeout => sub { $ENV{MOJO_REQUEST_TIMEOUT} // 0 };
 has transactor => sub { Mojo::UserAgent::Transactor->new };
 
 # Common HTTP methods
-{
-  no strict 'refs';
-  for my $name (qw(DELETE GET HEAD OPTIONS PATCH POST PUT)) {
-    *{__PACKAGE__ . '::' . lc($name)} = sub {
-      my $self = shift;
-      my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
-      return $self->start($self->build_tx($name, @_), $cb);
-    };
-  }
+for my $name (qw(DELETE GET HEAD OPTIONS PATCH POST PUT)) {
+  monkey_patch __PACKAGE__, lc($name), sub {
+    my $self = shift;
+    my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
+    return $self->start($self->build_tx($name, @_), $cb);
+  };
 }
 
 sub DESTROY { shift->_cleanup }

diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm
@@ -43,9 +43,9 @@ my %CACHE;
 our @EXPORT_OK = (
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
   qw(decode encode get_line hmac_md5_sum hmac_sha1_sum html_escape),
-  qw(html_unescape md5_bytes md5_sum punycode_decode punycode_encode quote),
-  qw(secure_compare sha1_bytes sha1_sum slurp spurt squish trim unquote),
-  qw(url_escape url_unescape xml_escape xor_encode)
+  qw(html_unescape md5_bytes md5_sum monkey_patch punycode_decode),
+  qw(punycode_encode quote secure_compare sha1_bytes sha1_sum slurp spurt),
+  qw(squish trim unquote url_escape url_unescape xml_escape xor_encode)
 );
 
 sub b64_decode { decode_base64($_[0]) }
@@ -130,6 +130,13 @@ sub html_unescape {
 sub md5_bytes { md5(@_) }
 sub md5_sum   { md5_hex(@_) }
 
+sub monkey_patch {
+  my ($class, $name, $cb) = @_;
+  no strict 'refs';
+  no warnings 'redefine';
+  *{"${class}::$name"} = $cb;
+}
+
 sub punycode_decode {
   my $input = shift;
   use integer;
@@ -533,6 +540,14 @@ Generate binary MD5 checksum for string.
 
 Generate MD5 checksum for string.
 
+=head2 C<monkey_patch>
+
+  monkey_patch $class, $name, sub {...};
+
+Monkey patch function into class.
+
+  monkey_patch 'MyApp', 'hello', sub { say 'Hello!' };
+
 =head2 C<punycode_decode>
 
   my $string = punycode_decode $punycode;

diff --git a/lib/Mojolicious/Lite.pm b/lib/Mojolicious/Lite.pm
@@ -5,6 +5,7 @@ use Mojo::Base 'Mojolicious';
 use File::Basename 'dirname';
 use File::Spec::Functions 'catdir';
 use Mojo::UserAgent;
+use Mojo::Util 'monkey_patch';
 
 sub import {
   my $class = shift;
@@ -17,8 +18,8 @@ sub import {
     unless $ENV{MOJO_HOME};
 
   # Initialize app
-  no strict 'refs';
   my $caller = caller;
+  no strict 'refs';
   push @{"${caller}::ISA"}, 'Mojo';
   my $app = $class->new;
 
@@ -29,23 +30,22 @@ sub import {
   $app->static->classes->[0] = $app->renderer->classes->[0] = $caller;
 
   # Export
-  no warnings 'redefine';
   my $root = $routes;
   for my $name (qw(any get options patch post put websocket)) {
-    *{"${caller}::$name"} = sub { $routes->$name(@_) };
+    monkey_patch $caller, $name, sub { $routes->$name(@_) };
   }
-  *{"${caller}::$_"} = sub {$app}
+  monkey_patch $caller, $_, sub {$app}
     for qw(new app);
-  *{"${caller}::del"} = sub { $routes->delete(@_) };
-  *{"${caller}::group"} = sub (&) {
+  monkey_patch $caller, 'del', sub { $routes->delete(@_) };
+  monkey_patch $caller, 'group', sub (&) {
     my $old = $root;
     $_[0]->($root = $routes);
     ($routes, $root) = ($root, $old);
   };
-  *{"${caller}::helper"} = sub { $app->helper(@_) };
-  *{"${caller}::hook"}   = sub { $app->hook(@_) };
-  *{"${caller}::plugin"} = sub { $app->plugin(@_) };
-  *{"${caller}::under"}  = sub { $routes = $root->under(@_) };
+  monkey_patch $caller, 'helper', sub { $app->helper(@_) };
+  monkey_patch $caller, 'hook',   sub { $app->hook(@_) };
+  monkey_patch $caller, 'plugin', sub { $app->plugin(@_) };
+  monkey_patch $caller, 'under',  sub { $routes = $root->under(@_) };
 
   # Make sure there's a default application for testing
   Mojo::UserAgent->app($app) unless Mojo::UserAgent->app;

diff --git a/lib/ojo.pm b/lib/ojo.pm
@@ -6,6 +6,7 @@ use Mojo::Collection 'c';
 use Mojo::DOM;
 use Mojo::JSON;
 use Mojo::UserAgent;
+use Mojo::Util 'monkey_patch';
 
 # Silent oneliners
 $ENV{MOJO_LOG_LEVEL} ||= 'fatal';
@@ -15,12 +16,8 @@ my $UA = Mojo::UserAgent->new;
 
 sub import {
 
-  # Prepare exports
-  my $caller = caller;
-  no strict 'refs';
-  no warnings 'redefine';
-
   # Mojolicious::Lite
+  my $caller = caller;
   eval "package $caller; use Mojolicious::Lite;";
 
   # Allow redirects
@@ -30,29 +27,30 @@ sub import {
   $UA->detect_proxy unless defined $ENV{MOJO_PROXY};
 
   # Application
-  $UA->app(*{"${caller}::app"}->());
+  $UA->app($caller->app);
 
   # Functions
-  *{"${caller}::a"} = sub { *{"${caller}::any"}->(@_) and return $UA->app };
-  *{"${caller}::b"} = \&b;
-  *{"${caller}::c"} = \&c;
-  *{"${caller}::d"} = sub { _request($UA->build_tx(DELETE => @_)) };
-  *{"${caller}::f"} = sub { _request($UA->build_form_tx(@_)) };
-  *{"${caller}::g"} = sub { _request($UA->build_tx(GET => @_)) };
-  *{"${caller}::h"} = sub { _request($UA->build_tx(HEAD => @_)) };
-  *{"${caller}::j"} = sub {
+  monkey_patch $caller, 'a',
+    sub { $caller->can('any')->(@_) and return $UA->app };
+  monkey_patch $caller, 'b', \&b;
+  monkey_patch $caller, 'c', \&c;
+  monkey_patch $caller, 'd', sub { _request($UA->build_tx(DELETE => @_)) };
+  monkey_patch $caller, 'f', sub { _request($UA->build_form_tx(@_)) };
+  monkey_patch $caller, 'g', sub { _request($UA->build_tx(GET => @_)) };
+  monkey_patch $caller, 'h', sub { _request($UA->build_tx(HEAD => @_)) };
+  monkey_patch $caller, 'j', sub {
     my $d = shift;
     my $j = Mojo::JSON->new;
     return $j->encode($d) if ref $d eq 'ARRAY' || ref $d eq 'HASH';
     return $j->decode($d);
   };
-  *{"${caller}::n"} = sub { _request($UA->build_json_tx(@_)) };
-  *{"${caller}::o"} = sub { _request($UA->build_tx(OPTIONS => @_)) };
-  *{"${caller}::p"} = sub { _request($UA->build_tx(POST => @_)) };
-  *{"${caller}::r"} = sub { $UA->app->dumper(@_) };
-  *{"${caller}::t"} = sub { _request($UA->build_tx(PATCH => @_)) };
-  *{"${caller}::u"} = sub { _request($UA->build_tx(PUT => @_)) };
-  *{"${caller}::x"} = sub { Mojo::DOM->new(@_) };
+  monkey_patch $caller, 'n', sub { _request($UA->build_json_tx(@_)) };
+  monkey_patch $caller, 'o', sub { _request($UA->build_tx(OPTIONS => @_)) };
+  monkey_patch $caller, 'p', sub { _request($UA->build_tx(POST => @_)) };
+  monkey_patch $caller, 'r', sub { $UA->app->dumper(@_) };
+  monkey_patch $caller, 't', sub { _request($UA->build_tx(PATCH => @_)) };
+  monkey_patch $caller, 'u', sub { _request($UA->build_tx(PUT => @_)) };
+  monkey_patch $caller, 'x', sub { Mojo::DOM->new(@_) };
 }
 
 sub _request {

diff --git a/t/mojo/util.t b/t/mojo/util.t
@@ -10,9 +10,9 @@ use FindBin;
 use Mojo::Util
   qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize),
   qw(decode encode get_line hmac_md5_sum hmac_sha1_sum html_escape),
-  qw(html_unescape md5_bytes md5_sum punycode_decode punycode_encode quote),
-  qw(squish trim unquote secure_compare sha1_bytes sha1_sum slurp spurt),
-  qw(url_escape url_unescape xml_escape xor_encode);
+  qw(html_unescape md5_bytes md5_sum monkey_patch punycode_decode),
+  qw(punycode_encode quote squish trim unquote secure_compare sha1_bytes),
+  qw(sha1_sum slurp spurt url_escape url_unescape xml_escape xor_encode);
 
 # camelize
 is camelize('foo_bar_baz'), 'FooBarBaz', 'right camelized result';
@@ -393,4 +393,18 @@ my $file = catfile $dir, 'test.txt';
 spurt "just\nworks!", $file;
 is slurp($file), "just\nworks!", 'successful roundtrip';
 
+# monkey_patch
+{
+
+  package MojoMonkeyTest;
+  sub foo {'foo'}
+}
+ok !!MojoMonkeyTest->can('foo'), 'function "foo" exists';
+is MojoMonkeyTest::foo(), 'foo', 'right result';
+ok !MojoMonkeyTest->can('bar'), 'function "bar" does not exist';
+monkey_patch 'MojoMonkeyTest', 'bar', sub {'bar'};
+ok !!MojoMonkeyTest->can('bar'), 'function "bar" exists';
+is MojoMonkeyTest::bar(), 'bar', 'right result';
+
+
 done_testing();