[Bast-commits] r3635 - in trunk/Class-C3-Componentised: .
lib/Class/C3 t
ash at dev.catalyst.perl.org
ash at dev.catalyst.perl.org
Mon Jul 30 00:10:08 GMT 2007
Author: ash
Date: 2007-07-30 00:10:06 +0100 (Mon, 30 Jul 2007)
New Revision: 3635
Added:
trunk/Class-C3-Componentised/MANIFEST.SKIP
trunk/Class-C3-Componentised/Makefile.PL
trunk/Class-C3-Componentised/t/01-basic.t
Removed:
trunk/Class-C3-Componentised/Build.PL
trunk/Class-C3-Componentised/MANIFEST
trunk/Class-C3-Componentised/t/boilerplate.t
Modified:
trunk/Class-C3-Componentised/Changes
trunk/Class-C3-Componentised/lib/Class/C3/Componentised.pm
Log:
Update this module ready for relase, just need to write a few more tests.
Deleted: trunk/Class-C3-Componentised/Build.PL
===================================================================
--- trunk/Class-C3-Componentised/Build.PL 2007-07-29 21:01:45 UTC (rev 3634)
+++ trunk/Class-C3-Componentised/Build.PL 2007-07-29 23:10:06 UTC (rev 3635)
@@ -1,20 +0,0 @@
-use strict;
-use warnings;
-use Module::Build;
-
-my $builder = Module::Build->new(
- module_name => 'Class::C3::Componentised',
- dist_author => 'Matt S. Trout <mst at shadowcatsystems.co.uk>',
- license => 'perl',
- create_makefile_pl => 'passthrough',
- dist_version_from => 'lib/Class/C3/Componentised.pm',
- requires => {
- 'Class::C3' => 0,
- },
- build_requires => {
- 'Test::More' => 0,
- },
- add_to_cleanup => [ 'Class-C3-Componentised-*' ],
-);
-
-$builder->create_build_script();
Modified: trunk/Class-C3-Componentised/Changes
===================================================================
--- trunk/Class-C3-Componentised/Changes 2007-07-29 21:01:45 UTC (rev 3634)
+++ trunk/Class-C3-Componentised/Changes 2007-07-29 23:10:06 UTC (rev 3635)
@@ -1,5 +1,5 @@
Revision history for Class-C3-Componentised
0.01 soon
- First version, based on DBIx::Class r2082
+ First version, based on DBIx::Class::Componentised r3634
Deleted: trunk/Class-C3-Componentised/MANIFEST
===================================================================
--- trunk/Class-C3-Componentised/MANIFEST 2007-07-29 21:01:45 UTC (rev 3634)
+++ trunk/Class-C3-Componentised/MANIFEST 2007-07-29 23:10:06 UTC (rev 3635)
@@ -1,10 +0,0 @@
-Build.PL
-Changes
-MANIFEST
-META.yml # Will be created by "make dist"
-README
-lib/Class/C3/Componentised.pm
-t/00-load.t
-t/boilerplate.t
-t/pod-coverage.t
-t/pod.t
Copied: trunk/Class-C3-Componentised/MANIFEST.SKIP (from rev 3608, DBIx-Class/0.09/trunk/MANIFEST.SKIP)
===================================================================
--- trunk/Class-C3-Componentised/MANIFEST.SKIP (rev 0)
+++ trunk/Class-C3-Componentised/MANIFEST.SKIP 2007-07-29 23:10:06 UTC (rev 3635)
@@ -0,0 +1,45 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+^VERSIONING\.SKETCH$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\..*?\.sw[po]$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
+
+# Avoid copies to .orig
+\.orig$
+
+# Dont use Module::Build anymore
+^Build.PL$
Added: trunk/Class-C3-Componentised/Makefile.PL
===================================================================
--- trunk/Class-C3-Componentised/Makefile.PL (rev 0)
+++ trunk/Class-C3-Componentised/Makefile.PL 2007-07-29 23:10:06 UTC (rev 3635)
@@ -0,0 +1,14 @@
+use inc::Module::Install 0.67;
+
+name 'Class-C3-Componentised';
+all_from 'lib/Class/C3/Componentised.pm';
+author 'Ash Berlin <ash at cpan.org>';
+
+
+requires 'Class::C3';
+requires 'Class::Inspector';
+requires 'Carp';
+
+build_requires 'FindBin';
+
+WriteAll;
Modified: trunk/Class-C3-Componentised/lib/Class/C3/Componentised.pm
===================================================================
--- trunk/Class-C3-Componentised/lib/Class/C3/Componentised.pm 2007-07-29 21:01:45 UTC (rev 3634)
+++ trunk/Class-C3-Componentised/lib/Class/C3/Componentised.pm 2007-07-29 23:10:06 UTC (rev 3635)
@@ -1,41 +1,64 @@
package Class::C3::Componentised;
+=head1 NAME
+
+Class::C3::Componentised
+
+=head1 DESCRIPTION
+
+Load mix-ins or components to your C3-based class.
+
+=head1 SYNOPSIS
+
+ package MyModule;
+
+ use strict;
+ use warnings;
+
+ use base 'Class::C3::Componentised';
+
+ sub component_base_class { "MyModule::Plugin" }
+
+ package main;
+
+ MyModule->load_components( $self->{plugins} );
+
+=head1 METHODS
+
+=cut
+
use strict;
use warnings;
-use vars qw($VERSION);
-
use Class::C3;
+use Class::Inspector;
+use Carp;
-$VERSION = "0.01";
+our $VERSION = 1.0000;
-sub inject_base {
- my ($class, $target, @to_inject) = @_;
- {
- no strict 'refs';
- my %seen;
- unshift( @{"${target}::ISA"},
- grep { !$seen{ $_ }++ && $target ne $_ && !$target->isa($_) }
- @to_inject
- );
- }
+=head2 load_components( @comps )
- # 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.
+Loads the given components into the current module. If a module begins with a
+C<+> character, it is taken to be a fully qualified class name, otherwise
+C<< $class->component_base_class >> is prepended to it.
- my $table = { Class::C3::_dump_MRO_table };
- eval "package $target; import Class::C3;" unless exists $table->{$target};
-}
+Calling this will call C<Class::C3::reinitialize>.
+=cut
+
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();
}
+=head2 load_own_components( @comps )
+
+Simialr to L<load_components>, but assumes every class is C<"$class::$comp">.
+
+=cut
+
sub load_own_components {
my $class = shift;
my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
@@ -45,45 +68,118 @@
sub _load_components {
my ($class, @comp) = @_;
foreach my $comp (@comp) {
- eval "use $comp";
- die $@ if $@;
+ $class->ensure_class_loaded($comp);
}
$class->inject_base($class => @comp);
+ Class::C3::reinitialize();
}
-1;
+=head2 load_optional_components
-__END__
+As L<load_components>, but will silently ignore any components that cannot be
+found.
-=head1 NAME
+=cut
-Class::C3::Componentised - extend and mix classes at runtime
+sub load_optional_components {
+ my $class = shift;
+ my $base = $class->component_base_class;
+ my @comp = grep { $class->load_optional_class( $_ ) }
+ map { /^\+(.*)$/ ? $1 : "${base}::$_" }
+ grep { $_ !~ /^#/ } @_;
-=head1 SYNOPSIS
+ $class->_load_components( @comp ) if scalar @comp;
+}
- package MyApp;
+=head2 ensure_class_loaded
- use base "Class::C3::Componentised";
+Given a class name, tests to see if it is already loaded or otherwise
+defined. If it is not yet loaded, the package is require'd, and an exception
+is thrown if the class is still not loaded.
- sub component_base_class { "MyApp" };
-
+ BUG: For some reason, packages with syntax errors are added to %INC on
+ require
+=cut
- package main;
+#
+# TODO: handle ->has_many('rel', 'Class'...) instead of
+# ->has_many('rel', 'Some::Schema::Class'...)
+#
+sub ensure_class_loaded {
+ my ($class, $f_class) = @_;
- MyApp->load_components(qw/Foo Bar Baz/);
+ croak "Invalid class name $f_class"
+ if ($f_class=~m/(?:\b:\b|\:{3,})/);
+ return if Class::Inspector->loaded($f_class);
+ eval "require $f_class"; # require needs a bareword or filename
+ if ($@) {
+ if ($class->can('throw_exception')) {
+ $class->throw_exception($@);
+ } else {
+ croak $@;
+ }
+ }
+}
-=head1 DESCRIPTION
+=head2 ensure_class_found
+Returns true if the specified class is installed or already loaded, false
+otherwise
+
+=cut
+
+sub ensure_class_found {
+ my ($class, $f_class) = @_;
+ return Class::Inspector->loaded($f_class) ||
+ Class::Inspector->installed($f_class);
+}
+
+# Returns a true value if the specified class is installed and loaded
+# successfully, throws an exception if the class is found but not loaded
+# successfully, and false if the class is not installed
+sub _load_optional_class {
+ my ($class, $f_class) = @_;
+ if ($class->ensure_class_found($f_class)) {
+ $class->ensure_class_loaded($f_class);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
=head2 inject_base
-=head2 load_components
+Does the actual magic of adjusting @ISA on the target module.
-=head2 load_own_components
+=cut
+sub inject_base {
+ my ($class, $target, @to_inject) = @_;
+ {
+ no strict 'refs';
+ foreach my $to (reverse @to_inject) {
+ unshift( @{"${target}::ISA"}, $to )
+ unless ($target eq $to || $target->isa($to));
+ }
+ }
+
+ # 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.
+
+ eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target};
+}
+
=head1 AUTHOR
-Matt S. Trout <mst at shadowcatsystems.co.uk>
+Matt S. Trout and the DBIx::Class team
+Pulled out into seperate module by Ash Berlin C<< <ash at cpan.org> >>
+
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
Added: trunk/Class-C3-Componentised/t/01-basic.t
===================================================================
--- trunk/Class-C3-Componentised/t/01-basic.t (rev 0)
+++ trunk/Class-C3-Componentised/t/01-basic.t 2007-07-29 23:10:06 UTC (rev 3635)
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+use Test::Exception;
+
+plan tests => 3;
+
+use_ok('MyModule');
+
+MyModule->load_components('Foo');
+
+throws_ok { MyModule->load_components('+Foo'); } qr/^Can't locate Foo.pm in \@INC/;
+
+is(MyModule->new->message, "Foo MyModule", "it worked");
+
Deleted: trunk/Class-C3-Componentised/t/boilerplate.t
===================================================================
--- trunk/Class-C3-Componentised/t/boilerplate.t 2007-07-29 21:01:45 UTC (rev 3634)
+++ trunk/Class-C3-Componentised/t/boilerplate.t 2007-07-29 23:10:06 UTC (rev 3635)
@@ -1,48 +0,0 @@
-#!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');
More information about the Bast-commits
mailing list