From: Dave Rolsky Date: Sun, 20 May 2012 20:15:48 +0000 (-0500) Subject: initial commit X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e60f0d8e2a14ca633e5f50ab34cebe6a9adc452;p=gitmo%2FMooseX-Compiler.git initial commit --- 9e60f0d8e2a14ca633e5f50ab34cebe6a9adc452 diff --git a/Changes b/Changes new file mode 100644 index 0000000..55b254b --- /dev/null +++ b/Changes @@ -0,0 +1,3 @@ + + +- First release upon an unsuspecting world. diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..bdeef35 --- /dev/null +++ b/dist.ini @@ -0,0 +1,38 @@ +name = MooseX-Compiler +author = Dave Rolsky +license = Artistic_2_0 +copyright_holder = Dave Rolsky + +version = 0.01 + +[NextRelease] +format = %-8v %{yyyy-MM-dd}d + +[@Basic] + +[InstallGuide] +[MetaJSON] + +[MetaResources] +bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Compiler +bugtracker.mailto = bug-moosex-compiler@rt.cpan.org +repository.url = git://git.urth.org/MooseX-Compiler.git +repository.web = http://git.urth.org/MooseX-Compiler.git +repository.type = git + +[SurgicalPodWeaver] + +[PkgVersion] + +[EOLTests] +[NoTabsTests] +[PodSyntaxTests] +[Test::CPAN::Changes] +[Test::Pod::LinkCheck] +[Test::Pod::No404s] + +[AutoPrereqs] + +[CheckPrereqsIndexed] + +[@Git] diff --git a/lib/MooseX/Compiler.pm b/lib/MooseX/Compiler.pm new file mode 100644 index 0000000..5b73429 --- /dev/null +++ b/lib/MooseX/Compiler.pm @@ -0,0 +1,96 @@ +package MooseX::Compiler; + +use strict; +use warnings; + +use Module::Runtime qw( module_notional_filename ); +use PPI::Document; +use Scalar::Util qw( blessed ); + +use Moose; +use Moose::Util::TypeConstraints; + +my $moose_class = subtype, as 'ClassName', where { + $_[0]->can('meta') + && blessed $_[0]->meta() + && $_[0]->meta()->isa('Moose::Meta::Class'); +}; + +has class => ( + is => 'ro', + isa => $moose_class, + required => 1, +); + +has _class_meta => ( + is => 'ro', + isa => 'Moose::Meta::Class', + init_arg => undef, + lazy => 1, + default => sub { $_[0]->class()->meta() }, +); + +sub compile_class { + my $self = shift; + + my $code + = join q{}, + $self->_adjusted_class_content(), + $self->_adjusted_role_content(), + $self->_inlined_attribute_code(); + + return $code; +} + +sub _adjusted_class_content { + my $self = shift; + + my $pm_file = module_notional_filename( $self->class() ); + my $path_to_class = $INC{$pm_file} + or die "Cannot find $pm_file in %INC!"; + + my $doc = PPI::Document->new( $path_to_class->stringify() ) + or die PPI::Document->errstr(); + + my $use_nodes = $doc->find( + sub { + my $node = $_[1]; + return undef + if $node->isa('PPI::Statement') + && !$node->isa('PPI::Statement::Include'); + return undef if $node->isa('PPI::Structure'); + return 1 + if $node->isa('PPI::Statement::Include') + && $node->module() =~ /^Moose/; + return 0; + } + ); + + for my $node ( @{$use_nodes} ) { + my $replacement_code .= + defined $node->module_version() + ? join( + q{ }, + 'use', $node->module(), $node->module_version(), '()', ';', + ) + : '# ' . $node->content(); + + $node->insert_before( $_->clone() ) + for PPI::Document->new( \$replacement_code )->children(); + $node->remove(); + } + + return $doc->content(); +} + +sub _adjusted_role_content { + return q{}; +} + +sub _inlined_attribute_code { + return q{}; +} + +__PACKAGE__->meta()->make_immutable(); + +1; diff --git a/t/lib/Test/MooseX/Compiler.pm b/t/lib/Test/MooseX/Compiler.pm new file mode 100644 index 0000000..765ced0 --- /dev/null +++ b/t/lib/Test/MooseX/Compiler.pm @@ -0,0 +1,41 @@ +package Test::MooseX::Compiler; + +use strict; +use warnings; +use autodie; + +use Exporter qw( import ); +use File::Temp qw( tempdir ); +use Module::Runtime qw( module_notional_filename ); +use Path::Class qw( dir ); + +our @EXPORT_OK = qw( + save_class +); + +my $Dir = dir( tempdir( CLEANUP => 1 ) ); + +sub save_class { + my $class = shift; + my $code = shift; + + { + local $@; + eval $code; + die $@ if $@; + } + + my $pm_file = module_notional_filename($class); + my $path = $Dir->file($pm_file); + $path->dir()->mkpath( 0, 0755 ); + + open my $fh, '>', $path; + print {$fh} $code; + close $fh; + + $INC{$pm_file} = $path; + + return $pm_file; +} + +1; diff --git a/t/remove-use-moose.t b/t/remove-use-moose.t new file mode 100644 index 0000000..5cb5d07 --- /dev/null +++ b/t/remove-use-moose.t @@ -0,0 +1,79 @@ +use strict; +use warnings; + +use lib 't/lib'; + +use Test::MooseX::Compiler qw( save_class ); +use Test::More 0.88; + +use MooseX::Compiler; + +{ + my $code = <<'EOF'; +package Test::Class1; + +use strict; +use warnings; + +use Moose; + +sub foo { 42 } + +1; +EOF + + save_class( 'Test::Class1', $code ); + + my $compiler = MooseX::Compiler->new( + class => 'Test::Class1', + ); + + my $compiled = $compiler->compile_class(); + like( + $compiled, + qr/^\#\s*use Moose;\n/m, + 'use Moose declaration is commented out in compiled code' + ); + + unlike( + $compiled, + qr/^use Moose;\n/m, + 'original use Moose declaration is removed from compiled code' + ); +} + +{ + my $code = <<'EOF'; +package Test::Class2; + +use strict; +use warnings; + +use Moose 0.1; + +sub foo { 42 } + +1; +EOF + + save_class( 'Test::Class1', $code ); + + my $compiler = MooseX::Compiler->new( + class => 'Test::Class1', + ); + + my $compiled = $compiler->compile_class(); + unlike( + $compiled, + qr/^\#\s*use Moose;\n/m, + 'use Moose declaration is not commented out in compiled code' + ); + + like( + $compiled, + qr/^use\s+Moose\s+0\.1\s+\(\)\s*;\n/m, + 'original use Moose declaration is preserved, but () is added to prevent importing' + ); +} + +done_testing();