Revision history for Perl extension Moose
+0.09_03
+ * Moose
+ - 'use strict' and 'use warnings' are no longer
+ needed in Moose classes, Moose itself will
+ turn them on for you.
+ - added tests for this
+
+ * Moose::Role
+ - as with Moose, strict and warnings are
+ automatically turned on for you.
+ - added tests for this
+
0.09_02 Tues. May 16, 2006
* Moose
- added prototypes to the exported subs
use strict;
use warnings;
-our $VERSION = '0.09_02';
+our $VERSION = '0.09_03';
use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
--- /dev/null
+
+package Moose::Compiler;
+use Moose;
+
+our $VERSION = '0.01';
+
+has 'engine' => (
+ is => 'rw',
+ does => 'Moose::Compiler::Engine',
+ handles => [qw(
+ compile_class
+ )],
+ required => 1,
+);
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Compiler - The front end for the Moose compiler
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+This will return the metaclass associated with the given class.
+
+=item B<engine>
+
+=back
+
+=head1 DELEGATED METHODS
+
+=over 4
+
+=item B<compile_class>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
\ No newline at end of file
--- /dev/null
+
+package Moose::Compiler::Engine;
+use Moose::Role;
+
+our $VERSION = '0.01';
+
+requires 'compile_class';
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Compiler::Engine - An abstract roie for all Moose compiler engines
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+This will return the metaclass associated with the given role.
+
+=back
+
+=head1 REQUIRED METHODS
+
+=over 4
+
+=item B<compile_class>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
\ No newline at end of file
--- /dev/null
+
+package Moose::Compiler::Moose;
+use Moose;
+
+our $VERSION = '0.01';
+
+with 'Moose::Compiler::Engine';
+
+sub compile_class {
+ my ($self, $meta) = @_;
+ my $o = '';
+ $o .= ('package ' . $meta->name . ";\n");
+ $o .= ("use Moose;\n");
+ $o .= ("\n");
+ $o .= ("our \$VERSION = '" . $meta->version . "';\n");
+ $o .= ("\n");
+ foreach my $attr_name ($meta->get_attribute_list) {
+ my $attr = $meta->get_attribute($attr_name);
+ my @options;
+ push @options => ("is => '" . $attr->_is_metadata . "'")
+ if $attr->_is_metadata;
+ push @options => ("isa => '" . $attr->_isa_metadata . "'")
+ if $attr->_isa_metadata;
+ push @options => ("does => '" . $attr->_does_metadata . "'")
+ if $attr->_does_metadata;
+ $o .= ("has '" . $attr->name . "' => (" . (join ", " => @options) . ");\n");
+ }
+ $o .= ("\n");
+ $o .= ("1;\n");
+ $o .= ("\n");
+ $o .= ("__END__\n");
+ return $o;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Compiler::Moose - A Moose compiler engine for compiling to Moose
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+This will return the metaclass associated with the given role.
+
+=item B<compile_class>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+
+package Moose::Compiler::Perl5;
+use Moose;
+
+our $VERSION = '0.01';
+
+with 'Moose::Compiler::Engine';
+
+sub compile_class {
+ my ($self, $meta) = @_;
+ my $o = '';
+ $o .= ('package ' . $meta->name . ";\n");
+ $o .= ("\n");
+ $o .= ("use strict;\n");
+ $o .= ("use warnings;\n");
+ $o .= ("\n");
+ $o .= ("our \$VERSION = '" . $meta->version . "';\n");
+ $o .= ("\n");
+ $o .= ("sub new {\n");
+ $o .= (" my (\$class, \%params) = \@_;\n");
+ $o .= (" my \%proto = (\n");
+ foreach my $attr_name ($meta->get_attribute_list) {
+ $o .= (" '" . $attr_name . "' => undef,\n");
+ }
+ $o .= (" );\n");
+ $o .= (" return bless { \%proto, \%params } => \$class;\n");
+ $o .= ("}\n");
+ $o .= ("\n");
+
+ foreach my $attr_name ($meta->get_attribute_list) {
+ my $attr = $meta->get_attribute($attr_name);
+ $o .= ("sub " . $attr->reader . " {" . ('') . "}\n\n") if $attr->has_reader;
+ $o .= ("sub " . $attr->writer . " {" . ('') . "}\n\n") if $attr->has_writer;
+ $o .= ("sub " . $attr->accessor . " {" . ('') . "}\n\n") if $attr->has_accessor;
+ $o .= ("sub " . $attr->predicate . " {" . ('') . "}\n\n") if $attr->has_predicate;
+ }
+
+ $o .= ("1;\n");
+ $o .= ("\n");
+ $o .= ("__END__\n");
+ return $o;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Compiler::Perl5 - A Moose compiler engine for compiling to Perl 5
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+This will return the metaclass associated with the given role.
+
+=item B<compile_class>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+
+package Moose::Compiler::Perl6;
+use Moose;
+
+our $VERSION = '0.01';
+
+with 'Moose::Compiler::Engine';
+
+sub compile_class {
+ my ($self, $meta) = @_;
+ my $o = '';
+ $o .= ('class ' . $meta->name . "-" . $meta->version . " {\n");
+ $o .= ("\n");
+ foreach my $attr_name ($meta->get_attribute_list) {
+ my $attr = $meta->get_attribute($attr_name);
+ my @options;
+ push @options => ("is " . $attr->_is_metadata . "")
+ if $attr->_is_metadata;
+ push @options => ("does " . $attr->_does_metadata . "")
+ if $attr->_does_metadata;
+ $o .= (" has " . ($attr->_isa_metadata ? ($attr->_isa_metadata . " ") : '')
+ . "\$" . $attr->name . " " . (join " " => @options) . ";\n");
+ }
+ $o .= ("\n");
+ $o .= ("}\n");
+ return $o;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Compiler::Perl6 - A Moose compiler engine for compiling to Perl 6
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+This will return the metaclass associated with the given role.
+
+=item B<compile_class>
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
use Sub::Exporter;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
use Moose::Meta::Role;
use Moose::Util::TypeConstraints;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 25;
+use Test::Exception;
+use Test::LongString;
+
+BEGIN {
+ use_ok('Moose');
+ use_ok('Moose::Compiler');
+ use_ok('Moose::Compiler::Moose');
+ use_ok('Moose::Compiler::Perl6');
+ use_ok('Moose::Compiler::Perl5');
+}
+
+my $c = Moose::Compiler->new(engine => Moose::Compiler::Moose->new);
+isa_ok($c, 'Moose::Compiler');
+
+can_ok($c, 'engine');
+isa_ok($c->engine, 'Moose::Compiler::Moose');
+ok($c->engine->does('Moose::Compiler::Engine'), '... $c->engine does Moose::Compilter::Engine');
+
+{
+ package Foo;
+ use Moose;
+ our $VERSION = '1.0';
+
+ has 'bar' => (is => 'rw', isa => 'Bar');
+ has 'baz' => (is => 'ro', does => 'Baz');
+}
+
+can_ok($c, 'compile_class');
+
+{
+ my $compiled;
+ lives_ok {
+ $compiled = $c->compile_class(Foo->meta);
+ } '... we compiled the class successfully';
+ ok(defined $compiled, '... we go something');
+ is_string($compiled,
+q[package Foo;
+use Moose;
+
+our $VERSION = '1.0';
+
+has 'bar' => (is => 'rw', isa => 'Bar');
+has 'baz' => (is => 'ro', does => 'Baz');
+
+1;
+
+__END__
+],
+ '... got the right compiled source');
+}
+
+lives_ok {
+ $c->engine(Moose::Compiler::Perl6->new);
+} '... swapped engines successfully';
+isa_ok($c->engine, 'Moose::Compiler::Perl6');
+ok($c->engine->does('Moose::Compiler::Engine'), '... $c->engine does Moose::Compilter::Engine');
+
+{
+ my $compiled;
+ lives_ok {
+ $compiled = $c->compile_class(Foo->meta);
+ } '... we compiled the class successfully';
+ ok(defined $compiled, '... we go something');
+ is_string($compiled,
+q[class Foo-1.0 {
+
+ has Bar $bar is rw;
+ has $baz is ro does Baz;
+
+}
+],
+ '... got the right compiled source');
+}
+
+lives_ok {
+ $c->engine(Moose::Compiler::Perl5->new);
+} '... swapped engines successfully';
+isa_ok($c->engine, 'Moose::Compiler::Perl5');
+ok($c->engine->does('Moose::Compiler::Engine'), '... $c->engine does Moose::Compilter::Engine');
+
+{
+ my $compiled;
+ lives_ok {
+ $compiled = $c->compile_class(Foo->meta);
+ } '... we compiled the class successfully';
+ ok(defined $compiled, '... we go something');
+ is_string($compiled,
+q[package Foo;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.0';
+
+sub new {
+ my ($class, %params) = @_;
+ my %proto = (
+ 'bar' => undef,
+ 'baz' => undef,
+ );
+ return bless { %proto, %params } => $class;
+}
+
+sub bar {}
+
+sub baz {}
+
+1;
+
+__END__
+],
+ '... got the right compiled source') or diag $compiled;
+}
+
+