Permalink
Browse files

lots of meta stuff.....

  • Loading branch information...
1 parent b1b9388 commit 8a5372571ec7eca55984b09a47dbb70657912faf @Getty Getty committed Feb 14, 2012
Showing with 192 additions and 75 deletions.
  1. +0 −75 lib/DDG/Block.pm
  2. +37 −0 lib/DDG/Goodie.pm
  3. +6 −0 lib/DDG/Goodie/Role.pm
  4. +66 −0 lib/DDG/Meta.pm
  5. +37 −0 lib/DDG/Spice.pm
  6. +6 −0 lib/DDG/Spice/Role.pm
  7. +22 −0 t/40-goodie.t
  8. +18 −0 t/lib/DDGTest/Goodie/Simple.pm
View
@@ -1,80 +1,5 @@
package DDG::Block;
use Moo::Role;
-use Class::Load ':all';
-
-requires qw(
- query
- get_triggers_of_plugin
-);
-
-has plugins => (
- #isa => 'ArrayRef[Str|HashRef]',
- is => 'ro',
- lazy => 1,
- builder => '_build_plugins',
-);
-
-sub _build_plugins { die (ref shift)." requires plugins" }
-
-has return_one => (
- #isa => 'Bool',
- is => 'ro',
- default => sub { 1 },
-);
-
-has _plugin_objs => (
- # like ArrayRef[ArrayRef[$trigger,DDG::Block::Plugin]]',
- is => 'ro',
- lazy => 1,
- builder => '_build__plugin_objs',
-);
-sub plugin_objs { shift->_plugin_objs }
-
-sub _build__plugin_objs {
- my ( $self ) = @_;
- my @plugin_objs;
- for (@{$self->plugins}) {
- my $class;
- my %args;
- if (ref $_ eq 'HASH') {
- die "require a class key in hash" unless defined $_->{class};
- $class = delete $_->{class};
- %args = %{$_};
- } else {
- $class = $_;
- }
- $class = $self->parse_class($class);
- load_class($class);
- $args{block} = $self;
- my $plugin = $class->new(\%args);
- my @triggers = $self->get_triggers_of_plugin($plugin);
- @triggers = $self->empty_trigger unless @triggers;
- my @parsed_triggers;
- for (@triggers) {
- push @parsed_triggers, $self->parse_trigger($_);
- }
- push @plugin_objs, [
- \@parsed_triggers,
- $plugin,
- ] if @parsed_triggers;
- }
- return \@plugin_objs;
-}
-
-sub parse_class { shift; 'DDG::Plugin::'.(shift); }
-
-sub parse_trigger { shift; shift; }
-
-sub empty_trigger { return undef }
-
-sub run_plugin {
- my ( $self, $plugin, @args ) = @_;
-}
-
-sub BUILD {
- my ( $self ) = @_;
- $self->_plugin_objs;
-}
1;
View
@@ -0,0 +1,37 @@
+package DDG::Goodie;
+
+use strict;
+use warnings;
+use Carp;
+use DDG::Meta;
+require Moo::Role;
+require Moo;
+
+sub import {
+ my ( $class, %params ) = @_;
+ my $target = caller;
+
+ #
+ # Applying DDG::Goodie::Role
+ #
+
+ Moo::Role->apply_role_to_package($target,'DDG::Goodie::Role');
+
+ #
+ # Make blockable
+ #
+
+ DDG::Meta->make_blockable($target);
+
+ #
+ # Import Data::Printer
+ #
+
+ #
+ # let there be Moo!
+ #
+
+ goto &Moo::import;
+}
+
+1;
View
@@ -0,0 +1,6 @@
+package DDG::Goodie::Role;
+
+use Moo::Role;
+use Data::Printer;
+
+1;
View
@@ -0,0 +1,66 @@
+package DDG::Meta;
+
+use strict;
+use warnings;
+use Carp;
+
+sub make_blockable {
+ my ( $class, $target ) = @_;
+
+ #
+ # words gathering
+ #
+
+ {
+ my %words;
+ no strict "refs";
+ *{"${target}::all_words_by_type"} = sub { \%words };
+ *{"${target}::words"} = sub {
+ my @args;
+ if (ref $_[0] eq 'CODE') {
+ @args = { $_[0]->() };
+ } else {
+ @args = @_;
+ }
+ if (ref $args[0] eq 'HASH') {
+ my %types = %{$args[0]};
+ for my $type (keys %types) {
+ my $value = $types{$type};
+ $words{$type} = [] unless defined $words{$type};
+ my $ref = ref $value;
+ push @{$words{$type}}, ($ref eq 'ARRAY' ? @{$value} : $ref eq 'CODE' ? $value->() : $value);
+ }
+ } elsif (ref $args[0] eq 'CODE') {
+ croak "you cant give back CODEREFs as result of a CODEREF for words";
+ } else {
+ my $type = shift @args;
+ $words{$type} = [] unless defined $words{$type};
+ my $ref = ref $args[0];
+ push @{$words{$type}}, ($ref eq 'ARRAY' ? @{$args[0]} : $ref eq 'CODE' ? $args[0]->() : @args);
+ }
+ };
+ }
+
+ #
+ # regexp gathering
+ #
+
+ {
+ my @res;
+ no strict "refs";
+
+ *{"${target}::all_regexps"} = sub { @res };
+ *{"${target}::regexp"} = sub {
+ for (@_) {
+ my @arg_res = (ref $_ eq 'CODE' ? $_->() : ref $_ eq 'ARRAY' ? @{$_} : $_);
+ for (@arg_res) {
+ die 'regexp need to be a compiled regexp qr{...}' unless ref $_ eq 'REGEXP';
+ push @res, $_;
+ }
+ }
+ };
+ }
+
+}
+
+1;
View
@@ -0,0 +1,37 @@
+package DDG::Spice;
+
+use strict;
+use warnings;
+use Carp;
+use DDG::Meta;
+require Moo::Role;
+require Moo;
+
+sub import {
+ my ( $class, %params ) = @_;
+ my $target = caller;
+
+ #
+ # Applying DDG::Spice::Role
+ #
+
+ Moo::Role->apply_role_to_package($target,'DDG::Spice::Role');
+
+ #
+ # Make blockable
+ #
+
+ DDG::Meta->make_blockable($target);
+
+ #
+ # Import Data::Printer
+ #
+
+ #
+ # let there be Moo!
+ #
+
+ goto &Moo::import;
+}
+
+1;
View
@@ -0,0 +1,6 @@
+package DDG::Spice::Role;
+
+use Moo::Role;
+use Data::Printer;
+
+1;
View
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+use DDGTest::Goodie::Simple;
+
+my $goodie = DDGTest::Goodie::Simple->new;
+
+isa_ok($goodie,'DDGTest::Goodie::Simple');
+ok($goodie->does('DDG::Goodie::Role'),'DDGTest::Goodie::Simple');
+
+is_deeply(DDGTest::Goodie::Simple->all_words_by_type,{
+ around => [ "foo", "foofoo", "afoo", "afoofoo" ],
+ before => [ "bar", "baz", "buu", "abar", "abaz" ],
+},'Checking resulting all_words of DDGTest::Goodie::Simple',);
+
+done_testing;
@@ -0,0 +1,18 @@
+package DDGTest::Goodie::Simple;
+
+use DDG::Goodie;
+
+words around => 'foo';
+
+words before => 'bar', 'baz';
+words before => 'buu';
+
+words around => 'foofoo';
+
+words sub {
+ before => [qw(abar abaz)],
+};
+
+words around => sub { 'afoo', 'afoofoo' };
+
+1;

0 comments on commit 8a53725

Please sign in to comment.