From: Ash Berlin Date: Sun, 29 Jul 2007 23:10:06 +0000 (+0000) Subject: Update this module ready for relase, just need to write a few more tests. X-Git-Tag: v1.001000~36 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20169807eed2db062238ce83016b4be7f7d18ea2;p=p5sagit%2FClass-C3-Componentised.git Update this module ready for relase, just need to write a few more tests. --- diff --git a/Build.PL b/Build.PL deleted file mode 100644 index a066280..0000000 --- a/Build.PL +++ /dev/null @@ -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 ', - 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(); diff --git a/Changes b/Changes index 726c3f4..04bd7c2 100644 --- a/Changes +++ b/Changes @@ -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 diff --git a/MANIFEST b/MANIFEST deleted file mode 100644 index f9e1288..0000000 --- a/MANIFEST +++ /dev/null @@ -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 diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..376c070 --- /dev/null +++ b/MANIFEST.SKIP @@ -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$ diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..e6d0e7f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,14 @@ +use inc::Module::Install 0.67; + +name 'Class-C3-Componentised'; +all_from 'lib/Class/C3/Componentised.pm'; +author 'Ash Berlin '; + + +requires 'Class::C3'; +requires 'Class::Inspector'; +requires 'Carp'; + +build_requires 'FindBin'; + +WriteAll; diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm index 2cfcbce..8311ca3 100644 --- a/lib/Class/C3/Componentised.pm +++ b/lib/Class/C3/Componentised.pm @@ -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. + +=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, 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_own_components { 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, 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 + +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. + + BUG: For some reason, packages with syntax errors are added to %INC on + require +=cut + +# +# TODO: handle ->has_many('rel', 'Class'...) instead of +# ->has_many('rel', 'Some::Schema::Class'...) +# +sub ensure_class_loaded { + my ($class, $f_class) = @_; + + 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 $@; + } + } +} - use base "Class::C3::Componentised"; +=head2 ensure_class_found - sub component_base_class { "MyApp" }; - +Returns true if the specified class is installed or already loaded, false +otherwise - package main; +=cut - MyApp->load_components(qw/Foo Bar Baz/); +sub ensure_class_found { + my ($class, $f_class) = @_; + return Class::Inspector->loaded($f_class) || + Class::Inspector->installed($f_class); +} -=head1 DESCRIPTION +# 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. + +=cut -=head2 load_own_components +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 +Matt S. Trout and the DBIx::Class team + +Pulled out into seperate module by Ash Berlin C<< >> =head1 LICENSE You may distribute this code under the same terms as Perl itself. + +=cut + +1; diff --git a/t/01-basic.t b/t/01-basic.t new file mode 100644 index 0000000..0a09da6 --- /dev/null +++ b/t/01-basic.t @@ -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"); + diff --git a/t/boilerplate.t b/t/boilerplate.t deleted file mode 100644 index d0e41a1..0000000 --- a/t/boilerplate.t +++ /dev/null @@ -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');