init

.travis.yml

@@ -0,0 +1,24 @@
+language: perl
+perl:
+    - '5.20'
+env:
+    - BACKEND=moar
+    - BACKEND=jvm
+matrix:
+    allow_failures:
+        - env: BACKEND=jvm
+    fast_finish: true
+sudo: false
+before_install:
+    - git clone https://github.com/rakudo/rakudo.git $HOME/rakudo
+    - cd $HOME/rakudo
+    - 'if [[ $BACKEND == "moar" ]]; then perl Configure.pl --gen-moar --gen-nqp --backends=$BACKEND; fi'
+    - 'if [[ $BACKEND == "jvm" ]]; then perl Configure.pl --gen-nqp --backends=$BACKEND; fi'
+    - make install
+    - export PATH=$HOME/rakudo/install/bin:$PATH
+    - cd $TRAVIS_BUILD_DIR
+install:
+    # need at least 1 statement in 'install'
+    - perl6 -v
+script:
+    - prove -v -e 'perl6 -Ilib' t/

META.info

@@ -0,0 +1,10 @@
+{
+  "name" : "Module::Does",
+  "version" : "0.1",
+  "description" : "role for finding loaded modules in global scope that 'does' some role or class, useful for modules that want to support hot swapping modules with minimal end user code",
+  "depends" : [],
+  "provides" : {
+      "Module::Does": "lib/Module/Does.pm6"
+  },
+  "source-url" : "git://github.com/tony-o/perl6-module-does.git"
+}

lib/Module/Does.pm6

@@ -0,0 +1,32 @@
+
+sub findglob($type, @start = GLOBAL::.values.Slip){
+  my @found;
+  for @start -> $t {
+    try @found.append: |@(findglob($type, $t.WHO.values.Slip));
+    try @found.append: $t if $t ~~ ::($type);
+  }
+  return @found;
+}
+
+role Module::Does[*@types] {
+  has %!base-types;
+  submethod BUILD(*%_){
+    for @types {
+      $_ = $_.^name unless $_ ~~ Pair || $_ ~~ Str;
+      given $_ {
+        when * ~~ Pair {
+          %!base-types{$_.key} = findglob($_.key);
+          %!base-types{$_.key} = findglob($_.value) unless
+            %!base-types{$_.key}.elems > 0;
+        }
+        when Str {
+          %!base-types{$_} = findglob($_);
+        }
+        default {
+          die "Unknown type passed $_";
+        }
+      }
+    }
+    callsame;
+  }
+}

t/00-test.t

@@ -0,0 +1,26 @@
+#!/usr/bin/env perl6
+
+use lib 'lib';
+use Module::Does;
+use Test;
+
+plan 5;
+
+class C { has $.x = 5; }
+role D { has $.y = 42; }
+class F does D { };
+
+class A does Module::Does[@(C, D => 'E', Module::Does)] {
+  has $.xx = 24; 
+  method base-types { %!base-types; }
+}
+
+my A $a .=new;
+
+ok C ~~ any(@($a.base-types<C>));
+ok F ~~ any(@($a.base-types<D>));
+ok D ~~ any(@($a.base-types<D>));
+ok Module::Does ~~ any(@($a.base-types<Module::Does>));
+ok A ~~ any(@($a.base-types<Module::Does>));
+
+# vi:syntax=perl6