Toby Inkster avatar Toby Inkster committed 8c69fb9

This doesn't actually work; will revert immediately.

Comments (0)

Files changed (2)

lib/Monkey/Patcher.pm

+package Monkey::Patcher;
+
+use 5.010;
+use strict;
+
+use Data::UUID;
+use Monkey::Patch qw/patch_package/;
+use Sub::Name qw/subname/;
+
+sub import
+{
+	my ($callee) = @_;
+	my ($caller) = caller(0);
+	
+	{
+		warn "INSTALLING METHODS TO $caller";
+		no strict 'refs';
+		*{"$caller\::import"}   = subname("$caller\::import", \&exported_import);
+		*{"$caller\::unimport"} = subname("$caller\::unimport", \&exported_unimport);
+	}
+}
+
+{
+	my $uuid = Data::UUID->new;
+	my %saved;
+
+	sub exported_import
+	{
+		my ($callee) = @_;
+		warn "$callee\->import";
+		my @caller = caller(0);
+		
+		my %patches = do {
+			no strict 'refs';
+			%{"$callee\::MONKEY_PATCHES"};
+			};
+			
+		my %monkeys;
+		while (my ($name, $code) = each %patches)
+		{
+			warn "  patch $name";
+			my ($class_name, $sub_name) = ($name =~ /^(.+)::([^:]+)$/);
+			my $named_code  = subname($name, $code);
+			$monkeys{$name} = patch_package($class_name, $sub_name, $named_code);
+		}
+		
+		my $id = $uuid->create_str;
+		$^H{$callee} = $id;
+		$saved{$id} = \%monkeys;
+		
+		'This monkey has been patched!';
+	}
+
+	sub exported_unimport
+	{
+		my ($callee) = @_;
+		warn "$callee\->unimport";
+		my @caller = caller(0);
+		
+		my $id = delete $^H{$callee};
+		
+		foreach my $name (keys %{ $saved{$id} })
+		{
+			print "  destroying $name\n" if ref $saved{$id}{$name};
+			$saved{$id}{$name}->DESTROY;
+		}
+		
+		delete $saved{$id};
+	}
+}
+
+1;

lib/RDF/Shortcuts/MonkeyPatch.pm

+package RDF::Shortcuts::MonkeyPatch;
+
 use 5.010;
 use common::sense;
 use utf8;
 use RDF::Shortcuts qw/parse serialize query flatten_iterator node/;
 use RDF::Trine;
 
+use Monkey::Patcher;
+our %MONKEY_PATCHES;
 BEGIN
 {
-	*RDF::Trine::Model::parse =
-		sub
-		{
-			my ($self, $input, %args) = @_;
-			return parse($input, %args, model=>$self);
-		};
-	
-	*RDF::Trine::Model::serialize =
-		sub
-		{
-			my ($self, $format) = @_;
-			return serialize($self, $format);
-		};
-	
-	*RDF::Trine::Model::sparql =
-		sub
-		{
-			my ($self, $sparql) = @_;
-			return query($sparql, $self);
-		};
-	
-	*RDF::Trine::Iterator::flatten =
-		sub
-		{
-			my ($self, %args) = @_;
-			return flatten_iterator($self, %args);
-		};
+	%MONKEY_PATCHES =
+	(
+		'RDF::Trine::Model::parse' =>
+			sub
+			{
+				my ($self, $input, %args) = @_;
+				return parse($input, %args, model=>$self);
+			},
+		
+		'RDF::Trine::Model::serialize' =>
+			sub
+			{
+				my ($self, $format) = @_;
+				return serialize($self, $format);
+			},
+		
+		'RDF::Trine::Model::sparql' =>
+			sub
+			{
+				my ($self, $sparql) = @_;
+				return query($sparql, $self);
+			},
+		
+		'RDF::Trine::Iterator::flatten' =>
+			sub
+			{
+				my ($self, %args) = @_;
+				return flatten_iterator($self, %args);
+			},
 
-	*RDF::Trine::Node::new =
-		sub
-		{
-			my ($class, $string, %args) = @_;
-			return node($string, %args);
-		};
+		'RDF::Trine::Node::new' =>
+			sub
+			{
+				my ($class, $string, %args) = @_;
+				return node($string, %args);
+			},
+	);	
 }
 
 1;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.