lib/Mouse/Util.pm

   1 #!/usr/bin/env perl
   2 package Mouse::Util;
   3 use strict;
   4 use warnings;
   5 use base 'Exporter';
   6
   7 our %dependencies = (
   8     'MRO::Compat' => {
   9         'get_linear_isa' => {
  10             loaded     => \&mro::get_linear_isa,
  11             not_loaded => do {
  12                 # this recurses so it isn't pretty
  13                 my $code;
  14                 $code = sub {
  15                     no strict 'refs';
  16
  17                     my $classname = shift;
  18
  19                     my @lin = ($classname);
  20                     my %stored;
  21                     foreach my $parent (@{"$classname\::ISA"}) {
  22                         my $plin = $code->($parent);
  23                         foreach (@$plin) {
  24                             next if exists $stored{$_};
  25                             push(@lin, $_);
  26                             $stored{$_} = 1;
  27                         }
  28                     }
  29                     return \@lin;
  30                 }
  31             },
  32         },
  33     },
  34 );
  35
  36 our @EXPORT_OK = map { keys %$_ } values %dependencies;
  37
  38 for my $module_name (keys %dependencies) {
  39     (my $file = "$module_name.pm") =~ s{::}{/}g;
  40
  41     my $loaded = do {
  42         local $SIG{__DIE__} = 'DEFAULT';
  43         eval "require '$file'; 1";
  44     };
  45
  46     for my $method_name (keys %{ $dependencies{ $module_name } }) {
  47         my $producer = $dependencies{$module_name}{$method_name};
  48         my $implementation;
  49
  50         if (ref($producer) eq 'HASH') {
  51             $implementation = $loaded
  52                             ? $producer->{loaded}
  53                             : $producer->{not_loaded};
  54         }
  55         else {
  56             $implementation = $loaded
  57                             ? $module_name->can($method_name)
  58                             : $producer;
  59         }
  60
  61         no strict 'refs';
  62         *{ __PACKAGE__ . '::' . $method_name } = $implementation;
  63     }
  64 }
  65
  66 1;
  67