From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 28 Sep 2008 03:12:30 +0000 (+0000)
Subject: Mouse::Util for pure-perl implementations of functions we depend on, in case the... 
X-Git-Tag: 0.19~216
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=4093c85947564bfd87d50b401b7f5c1f488abebe;hp=2badb84a6fe5f279c120179030f77c62d9b4dd05

Mouse::Util for pure-perl implementations of functions we depend on, in case the dependencies are unavailable
---

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
new file mode 100644
index 0000000..cc78ccf
--- /dev/null
+++ b/lib/Mouse/Util.pm
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+package Mouse::Util;
+use strict;
+use warnings;
+use base 'Exporter';
+
+our %dependencies = (
+    'MRO::Compat' => {
+        'get_linear_isa' => {
+            loaded     => \&mro::get_linear_isa,
+            not_loaded => do {
+                # this recurses so it isn't pretty
+                my $code;
+                $code = sub {
+                    no strict 'refs';
+
+                    my $classname = shift;
+
+                    my @lin = ($classname);
+                    my %stored;
+                    foreach my $parent (@{"$classname\::ISA"}) {
+                        my $plin = $code->($parent);
+                        foreach (@$plin) {
+                            next if exists $stored{$_};
+                            push(@lin, $_);
+                            $stored{$_} = 1;
+                        }
+                    }
+                    return \@lin;
+                }
+            },
+        },
+    },
+);
+
+our @EXPORT_OK = map { keys %$_ } values %dependencies;
+
+for my $module_name (keys %dependencies) {
+    (my $file = "$module_name.pm") =~ s{::}{/}g;
+
+    my $loaded = do {
+        local $SIG{__DIE__} = 'DEFAULT';
+        eval "require '$file'; 1";
+    };
+
+    for my $method_name (keys %{ $dependencies{ $module_name } }) {
+        my $producer = $dependencies{$module_name}{$method_name};
+        my $implementation;
+
+        if (ref($producer) eq 'HASH') {
+            $implementation = $loaded
+                            ? $producer->{loaded}
+                            : $producer->{not_loaded};
+        }
+        else {
+            $implementation = $loaded
+                            ? $module_name->can($method_name)
+                            : $producer;
+        }
+
+        no strict 'refs';
+        *{ __PACKAGE__ . '::' . $method_name } = $implementation;
+    }
+}
+
+1;
+