From: Robert Norris <robn@cpan.org>
Date: Tue, 11 Jul 2006 06:32:50 +0000 (+0000)
Subject: checkpoint
X-Git-Tag: v1.001000~37
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FClass-C3-Componentised.git;a=commitdiff_plain;h=d288ce5366c6e385364d6406b5ded37c6fa27420

checkpoint
---

diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm
new file mode 100644
index 0000000..2cfcbce
--- /dev/null
+++ b/lib/Class/C3/Componentised.pm
@@ -0,0 +1,89 @@
+package Class::C3::Componentised;
+
+use strict;
+use warnings;
+
+use vars qw($VERSION);
+
+use Class::C3;
+
+$VERSION = "0.01";
+
+sub inject_base {
+  my ($class, $target, @to_inject) = @_;
+  {
+    no strict 'refs';
+    my %seen;
+    unshift( @{"${target}::ISA"},
+        grep { !$seen{ $_ }++ && $target ne $_ && !$target->isa($_) }
+            @to_inject
+    );
+  }
+
+  # Yes, this is hack. But it *does* work. Please don't submit tickets about
+  # it on the basis of the comments in Class::C3, the author was on #dbix-class
+  # while I was implementing this.
+
+  my $table = { Class::C3::_dump_MRO_table };
+  eval "package $target; import Class::C3;" unless exists $table->{$target};
+}
+
+sub load_components {
+  my $class = shift;
+  my $base = $class->component_base_class;
+  my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_;
+  $class->_load_components(@comp);
+  Class::C3::reinitialize();
+}
+
+sub load_own_components {
+  my $class = shift;
+  my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
+  $class->_load_components(@comp);
+}
+
+sub _load_components {
+  my ($class, @comp) = @_;
+  foreach my $comp (@comp) {
+    eval "use $comp";
+    die $@ if $@;
+  }
+  $class->inject_base($class => @comp);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Class::C3::Componentised - extend and mix classes at runtime
+
+=head1 SYNOPSIS
+
+    package MyApp;
+
+    use base "Class::C3::Componentised";
+
+    sub component_base_class { "MyApp" };
+    
+
+    package main;
+
+    MyApp->load_components(qw/Foo Bar Baz/);
+
+=head1 DESCRIPTION
+
+=head2 inject_base
+
+=head2 load_components
+
+=head2 load_own_components
+
+=head1 AUTHOR
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..26359f7
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+	use_ok( 'Class::C3::Componentised' );
+}
+
+diag( "Testing Class::C3::Componentised $Class::C3::Componentised::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..d0e41a1
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,48 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open my $fh, "<", $filename
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+module_boilerplate_ok('lib/Class/C3/Componentised.pm');
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..703f91d
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..976d7cd
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();