Commits

Toby Inkster committed 2cd6532

initial commit

Comments (0)

Files changed (13)

+use inc::Module::Package 'RDF 0.009';
+
+use 5.010;
+use MooseX::DeclareX
+	keywords  => [qw( class interface )],
+	plugins   => [qw( method test_case )],
+	;
+
+interface DatabaseAPI::ReadOnly
+{
+	test_case silly { 1 }
+	requires 'select';
+}
+
+interface DatabaseAPI::ReadWrite
+	extends DatabaseAPI::ReadOnly
+{
+	test_case sausage { 0 }
+	requires 'insert';
+	requires 'update';
+	requires 'delete';
+}
+
+class Database::MySQL
+	with DatabaseAPI::ReadWrite
+{
+	method insert { ... }
+	method select { ... }
+	method update { ... }
+	method delete { ... }
+}
+
+say Database::MySQL::->DOES('DatabaseAPI::ReadOnly');   # true
+say Database::MySQL::->DOES('DatabaseAPI::ReadWrite');  # true
+
+my $x = Database::MySQL::->new;
+say DatabaseAPI::ReadOnly->meta->test_implementation( $x ); # true
+say DatabaseAPI::ReadWrite->meta->test_implementation( $x ); # false

lib/MooseX/DeclareX/Keyword/interface.pm

+package MooseX::DeclareX::Keyword::interface;
+
+{
+	package # hide
+	MooseX::DeclareX::Keyword::interface::SupportsTestCases;
+	use Moose::Role;
+}
+
+BEGIN {
+	$MooseX::DeclareX::Keyword::interface::AUTHORITY = 'cpan:TOBYINK';
+	$MooseX::DeclareX::Keyword::interface::VERSION   = '0.001';
+}
+
+require MooseX::Declare;
+require MooseX::Interface;
+
+use Moose;
+with qw(
+	MooseX::Declare::Syntax::MooseSetup
+	MooseX::Declare::Syntax::Extending
+	MooseX::DeclareX::Plugin
+	MooseX::DeclareX::Registry
+	MooseX::DeclareX::Keyword::interface::SupportsTestCases
+);
+
+around import_symbols_from => sub { 'MooseX::Interface' };
+around imported_moose_symbols => sub { qw( requires excludes extends const ) };
+
+sub preferred_identifier { 'interface' }
+
+before add_namespace_customizations => sub {
+	my ($self, $ctx) = @_;
+	$_->setup_for($ctx->namespace, provided_by => ref $self)
+		foreach @{ $self->default_inner };
+};
+
+"Are you using Java?!"
+
+__END__
+
+=head1 NAME
+
+MooseX::DeclareX::Keyword::interface - shiny syntax for MooseX::Interface
+
+=head1 SYNOPSIS
+
+  use MooseX::DeclareX
+    keywords => [qw/ class interface /],
+    plugins  => [qw/ guard build test_case /];
+  
+  interface BankAccountAPI
+  {
+    requires 'deposit';
+    requires 'withdraw';
+    requires 'balance';
+    test_case numeric_balance {
+      Scalar::Util::looks_like_number( $_->balance )
+    }
+  }
+  
+  class BankAccount with BankAccountAPI
+  {
+    has owner => (
+      is       => 'ro',
+      isa      => 'Str',
+      required => 1,
+    );
+    has balance => (
+      traits   => ['Number'],
+      is       => 'rw',
+      isa      => 'Num',
+      handles  => {
+        deposit   => 'add',
+        withdraw  => 'sub',
+      },
+    );
+    build balance { 0 }
+    guard withdraw ($amt) {
+      confess "insufficient funds" unless $self->balance >= $amt
+    }
+  }
+  
+  interface DDBankAccountAPI extends BankAccountAPI
+  {
+    requires 'setup_direct_debit';
+    requires 'pay_direct_debit';
+  }
+  
+  BankAccountAPI->meta->test_implementation( BankAccount->new );
+
+=head1 DESCRIPTION
+
+This distribution adds a new keyword and a new plugin to L<MooseX::DeclareX>.
+
+=over
+
+=item C<< interface >>
+
+Defines an interface. An interface is much like a role, but with some heavy
+restrictions - it can't define any methods (just require implementing classes
+to define them), and it can only extend other interfaces, not roles. See
+L<MooseX::Interface> for details.
+
+=item C<< test_case >>
+
+Sets up test cases for an interface.
+
+=back
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-DeclareX-Keyword-interface>.
+
+=head1 SEE ALSO
+
+L<MooseX::DeclareX>, L<MooseX::Interface>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

lib/MooseX/DeclareX/Plugin/test_case.pm

+package MooseX::DeclareX::Plugin::test_case;
+
+BEGIN {
+	$MooseX::DeclareX::Plugin::test_case::AUTHORITY = 'cpan:TOBYINK';
+	$MooseX::DeclareX::Plugin::test_case::VERSION   = '0.001';
+}
+
+use Moose;
+with 'MooseX::DeclareX::Plugin';
+
+use MooseX::Declare ();
+use Moose::Util ();
+
+sub plugin_setup
+{
+	my ($class, $kw) = @_;
+	
+	$kw->meta->add_around_method_modifier('default_inner', \&_default_inner)
+		if $kw->can('default_inner') && $kw->does('MooseX::DeclareX::Keyword::interface::SupportsTestCases');
+}
+
+sub _default_inner
+{
+	my $orig = shift;
+	my $self = shift;
+	
+	my $return = $self->$orig(@_);
+	
+	push @$return,
+		'MooseX::DeclareX::Plugin::test_case::MethodModifier'->new(
+			identifier    => 'test_case',
+		);
+	
+	return $return;
+}
+
+package MooseX::DeclareX::Plugin::test_case::MethodModifier;
+
+BEGIN {
+	$MooseX::DeclareX::Plugin::test_case::MethodModifier::AUTHORITY = 'cpan:TOBYINK';
+	$MooseX::DeclareX::Plugin::test_case::MethodModifier::VERSION   = '0.001';
+}
+
+use Moose;
+extends 'MooseX::Declare::Syntax::Keyword::Method';
+
+override register_method_declaration => sub
+{
+	my ($me, $meta, $name, $method) = @_;
+	$meta->add_test_case($method->actual_body, $name);
+};
+
+1;

meta/changes.pret

+# This file acts as the project's changelog.
+
+`MooseX-DeclareX-Keyword-interface 0.001 cpan:TOBYINK`
+	issued  2012-08-22;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`MooseX-DeclareX-Keyword-interface`
+	:programming-language "Perl" ;
+	:shortdesc            "a module that does something-or-other";
+	:homepage             <https://metacpan.org/release/MooseX-DeclareX-Keyword-interface>;
+	:download-page        <https://metacpan.org/release/MooseX-DeclareX-Keyword-interface>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=MooseX-DeclareX-Keyword-interface>;
+	:repository           [ a :HgRepository; :browse <https://bitbucket.org/tobyink/p5-moosex-declarex-keyword-interface> ];
+	:created              2012-08-22;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+
+cpan:TOBYINK
+	foaf:name  "Toby Inkster";
+	foaf:mbox  <mailto:tobyink@cpan.org>.
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`MooseX-DeclareX-Keyword-interface`
+	perl_version_from m`MooseX::DeclareX::Keyword::interface`;
+	version_from      m`MooseX::DeclareX::Keyword::interface`;
+	readme_from       m`MooseX::DeclareX::Keyword::interface`;
+	requires          p`MooseX::Interface 0.002`;
+	requires          p`MooseX::DeclareX 0.002`;
+	test_requires     p`Test::More 0.61`.
+
+use Test::More tests => 1;
+BEGIN { use_ok('MooseX::DeclareX::Keyword::interface') };
+
+use Test::More tests => 4;
+use MooseX::DeclareX
+	keywords  => [qw( class interface )],
+	plugins   => [qw( method test_case )],
+	;
+
+interface DatabaseAPI::ReadOnly
+{
+	test_case this_should_pass { 1 }
+	requires 'select';
+}
+
+interface DatabaseAPI::ReadWrite
+	extends DatabaseAPI::ReadOnly
+{
+	test_case this_should_fail { 0 }
+	requires 'insert';
+	requires 'update';
+	requires 'delete';
+}
+
+class Database::MySQL
+	with DatabaseAPI::ReadWrite
+{
+	method insert { 1 }
+	method select { 1 }
+	method update { 1 }
+	method delete { 1 }
+}
+
+ok(
+	Database::MySQL::->DOES('DatabaseAPI::ReadOnly'),	
+);
+
+ok(
+	Database::MySQL::->DOES('DatabaseAPI::ReadWrite'),
+);
+
+my $x = Database::MySQL::->new;
+
+ok(
+	DatabaseAPI::ReadOnly->meta->test_implementation( $x ),
+);
+
+ok not(
+	DatabaseAPI::ReadWrite->meta->test_implementation( $x ),
+);
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use Test::More skip_all => "not a sane test for this dist";
+use Test::Pod::Coverage;
+
+my @modules = qw(MooseX::DeclareX::Keyword::interface);
+pod_coverage_ok($_, "$_ is covered") for @modules;
+done_testing(scalar @modules);
+

xt/03meta_uptodate.t

+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok('MooseX-DeclareX-Keyword-interface', 'MooseX::DeclareX::Keyword::interface');
+
+use Test::EOL;
+all_perl_files_ok();