r20463 - in /branches/upstream/libmoose-policy-perl: ./ current/ current/lib/ current/lib/Moose/ current/lib/Moose/Policy/ current/t/

antgel-guest at users.alioth.debian.org antgel-guest at users.alioth.debian.org
Wed May 28 13:27:38 UTC 2008


Author: antgel-guest
Date: Wed May 28 13:27:38 2008
New Revision: 20463

URL: http://svn.debian.org/wsvn/?sc=1&rev=20463
Log:
[svn-inject] Installing original source of libmoose-policy-perl

Added:
    branches/upstream/libmoose-policy-perl/
    branches/upstream/libmoose-policy-perl/current/
    branches/upstream/libmoose-policy-perl/current/Build.PL
    branches/upstream/libmoose-policy-perl/current/Changes
    branches/upstream/libmoose-policy-perl/current/MANIFEST
    branches/upstream/libmoose-policy-perl/current/MANIFEST.SKIP
    branches/upstream/libmoose-policy-perl/current/META.yml
    branches/upstream/libmoose-policy-perl/current/Makefile.PL
    branches/upstream/libmoose-policy-perl/current/README
    branches/upstream/libmoose-policy-perl/current/lib/
    branches/upstream/libmoose-policy-perl/current/lib/Moose/
    branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/
    branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy.pm
    branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/FollowPBP.pm
    branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/JavaAccessors.pm
    branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/SingleInheritence.pm
    branches/upstream/libmoose-policy-perl/current/t/
    branches/upstream/libmoose-policy-perl/current/t/000_load.t
    branches/upstream/libmoose-policy-perl/current/t/001_basic.t
    branches/upstream/libmoose-policy-perl/current/t/002_dynamic.t
    branches/upstream/libmoose-policy-perl/current/t/003_saidso.t
    branches/upstream/libmoose-policy-perl/current/t/010_FollowPBP_test.t
    branches/upstream/libmoose-policy-perl/current/t/011_JavaAccessors_test.t
    branches/upstream/libmoose-policy-perl/current/t/020_SingleInheritence_test.t
    branches/upstream/libmoose-policy-perl/current/t/pod.t
    branches/upstream/libmoose-policy-perl/current/t/pod_coverage.t

Added: branches/upstream/libmoose-policy-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/Build.PL?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/Build.PL (added)
+++ branches/upstream/libmoose-policy-perl/current/Build.PL Wed May 28 13:27:38 2008
@@ -1,0 +1,25 @@
+use Module::Build;
+
+use strict;
+
+my $build = Module::Build->new(
+    module_name => 'Moose::Policy',
+    license => 'perl',
+    requires => { 
+        'Moose' => '0.20',
+    },
+    optional => {
+    },
+    build_requires => {
+        'Test::More'       => '0.62',
+        'Test::Exception'  => '0.21',
+    },
+    create_makefile_pl => 'traditional',
+    recursive_test_files => 1,
+    add_to_cleanup => [
+        'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+    ],
+);
+
+$build->create_build_script;
+

Added: branches/upstream/libmoose-policy-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/Changes?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/Changes (added)
+++ branches/upstream/libmoose-policy-perl/current/Changes Wed May 28 13:27:38 2008
@@ -1,0 +1,16 @@
+Revision history for Perl extension Moose-Policy
+
+0.03 Sat. April 14th, 2007
+    - changing it to use the Class::MOP::is_class_loaded
+      and Class::MOP::load_class instead.
+    - fixed the metaclass loading to work with newer 
+      versions of Class::MOP
+
+0.02 Sun. Nov. 5, 2006
+    - We removed UNIVERSAL::require in Moose recently, and 
+      this module was breaking beacuse of that. It is now 
+      fixed.
+
+0.01 Wed. Aug. 9, 2006
+    - module created by Stevan Little and Eric Willhelm, 
+      with input form Matt Trout and the #moose crew.

Added: branches/upstream/libmoose-policy-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/MANIFEST?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/MANIFEST (added)
+++ branches/upstream/libmoose-policy-perl/current/MANIFEST Wed May 28 13:27:38 2008
@@ -1,0 +1,20 @@
+Build.PL
+Changes
+META.yml
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+lib/Moose/Policy.pm
+lib/Moose/Policy/FollowPBP.pm
+lib/Moose/Policy/JavaAccessors.pm
+lib/Moose/Policy/SingleInheritence.pm
+t/000_load.t
+t/001_basic.t
+t/002_dynamic.t
+t/003_saidso.t
+t/010_FollowPBP_test.t
+t/011_JavaAccessors_test.t
+t/020_SingleInheritence_test.t
+t/pod.t
+t/pod_coverage.t

Added: branches/upstream/libmoose-policy-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/MANIFEST.SKIP?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libmoose-policy-perl/current/MANIFEST.SKIP Wed May 28 13:27:38 2008
@@ -1,0 +1,19 @@
+^_build
+^Build$
+^blib
+~$
+\.bak$
+^MANIFEST\.SKIP$
+CVS
+\.svn
+\.DS_Store
+cover_db
+\..*\.sw.?$
+^Makefile$
+^pm_to_blib$
+^MakeMaker-\d
+^blibdirs$
+\.old$
+^#.*#$
+^\.#
+^TODO$

Added: branches/upstream/libmoose-policy-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/META.yml?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/META.yml (added)
+++ branches/upstream/libmoose-policy-perl/current/META.yml Wed May 28 13:27:38 2008
@@ -1,0 +1,34 @@
+---
+name: Moose-Policy
+version: 0.03
+author:
+  - 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
+abstract: Moose-mounted police
+license: perl
+resources:
+  license: http://dev.perl.org/licenses/
+requires:
+  Moose: 0.20
+build_requires:
+  Test::Exception: 0.21
+  Test::More: 0.62
+provides:
+  Moose::Policy:
+    file: lib/Moose/Policy.pm
+    version: 0.03
+  Moose::Policy::FollowPBP:
+    file: lib/Moose/Policy/FollowPBP.pm
+  Moose::Policy::FollowPBP::Attribute:
+    file: lib/Moose/Policy/FollowPBP.pm
+  Moose::Policy::JavaAccessors:
+    file: lib/Moose/Policy/JavaAccessors.pm
+  Moose::Policy::JavaAccessors::Attribute:
+    file: lib/Moose/Policy/JavaAccessors.pm
+  Moose::Policy::SingleInheritence:
+    file: lib/Moose/Policy/SingleInheritence.pm
+  Moose::Policy::SingleInheritence::MetaClass:
+    file: lib/Moose/Policy/SingleInheritence.pm
+generated_by: Module::Build version 0.2805
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.2.html
+  version: 1.2

Added: branches/upstream/libmoose-policy-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/Makefile.PL?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/Makefile.PL (added)
+++ branches/upstream/libmoose-policy-perl/current/Makefile.PL Wed May 28 13:27:38 2008
@@ -1,0 +1,16 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+          'PL_FILES' => {},
+          'INSTALLDIRS' => 'site',
+          'NAME' => 'Moose::Policy',
+          'EXE_FILES' => [],
+          'VERSION_FROM' => 'lib/Moose/Policy.pm',
+          'PREREQ_PM' => {
+                           'Test::More' => '0.62',
+                           'Test::Exception' => '0.21',
+                           'Moose' => '0.20'
+                         }
+        )
+;

Added: branches/upstream/libmoose-policy-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/README?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/README (added)
+++ branches/upstream/libmoose-policy-perl/current/README Wed May 28 13:27:38 2008
@@ -1,0 +1,29 @@
+Moose::Policy version 0.03
+===========================
+
+See the individual module documentation for more information
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+    Moose
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006-2007 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+

Added: branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy.pm?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy.pm (added)
+++ branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy.pm Wed May 28 13:27:38 2008
@@ -1,0 +1,192 @@
+package Moose::Policy;
+use Moose 'confess', 'blessed';
+
+our $VERSION   = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub import {
+    shift;
+
+    my $policy = shift || return;
+
+    unless (Class::MOP::is_class_loaded($policy)) {
+        # otherwise require it ...
+        eval { Class::MOP::load_class($policy) };
+        confess "Could not load policy module '$policy' because : $@"
+            if $@;        
+    }
+
+    my $package = caller();
+    $package->can('meta') and
+        croak("'$package' already has a meta() method, this is very problematic");
+
+    my $metaclass = 'Moose::Meta::Class';
+    $metaclass = $policy->metaclass($package)
+        if $policy->can('metaclass');
+
+    my %options;
+
+    # build options out of policy's constants
+    $policy->can($_) and $options{"$_"} = $policy->$_($package)
+        for (qw(
+            attribute_metaclass
+            instance_metaclass
+            method_metaclass
+            ));
+
+    # create a meta object so we can install &meta
+    my $meta = $metaclass->initialize($package => %options);
+    $meta->add_method('meta' => sub {
+        # we must re-initialize so that it works as expected in
+        # subclasses, since metaclass instances are singletons, this is
+        # not really a big deal anyway.
+        $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
+    });
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Policy - Moose-mounted police
+
+=head1 SYNOPSIS
+
+  package Foo;
+
+  use Moose::Policy 'Moose::Policy::FollowPBP';
+  use Moose;
+
+  has 'bar' => (is => 'rw', default => 'Foo::bar');
+  has 'baz' => (is => 'ro', default => 'Foo::baz');
+
+  # Foo now has (get, set)_bar methods as well as get_baz
+
+=head1 DESCRIPTION
+
+This module allows you to specify your project-wide or even company-wide 
+Moose meta-policy. 
+
+Most all of Moose's features can be customized through the use of custom 
+metaclasses, however fiddling with the metaclasses can be hairy. Moose::Policy 
+removes most of that hairiness and makes it possible to cleanly contain 
+a set of meta-level customizations in one easy to use module.
+
+This is still an release of this module and it should not be considered to 
+be complete by any means. It is very basic implemenation at this point and 
+will likely get more feature-full over time, as people request features.
+So if you have a suggestion/need/idea, please speak up.
+
+=head2 What is a meta-policy?
+
+A meta-policy is a set of custom Moose metaclasses which can be used to 
+implement a number of customizations and restrictions on a particular 
+Moose class. 
+
+For instance, L<Moose::Policy::SingleInheritence> enforces that all 
+specified Moose classes can only use single inheritence. It does this 
+by trapping the call to C<superclasses> on the metaclass and only allowing 
+you to assign a single superclass. 
+
+The L<Moose::Policy::FollowPBP> policy changes the default behavior of 
+accessors to fit the recomendations found in Perl Best Practices. 
+
+=head1 CAVEATS
+
+=head2 Always load Moose::Policy first.
+
+You B<must> put the following line of code: 
+
+  use Moose::Policy 'My::Policy';
+
+before this line:
+
+  use Moose;
+
+This is because Moose::Policy must be given the opportunity to set the 
+custom metaclass before Moose has set it's default metaclass. In fact, if 
+you try to set a Moose::Policy and there is a C<meta> method available, 
+not only will kittens die, but your program will too.
+
+=head2 Policys are class scoped
+
+You must repeat the policy for each class you want to us it. It is B<not> 
+inherited. This may change in the future, probably it will be a Moose::Policy 
+itself to allow Moose policys to be inherited.
+
+=head1 THE POLICY
+
+A Policy is set by passing C<Moose::Polocy::import()> a package name.  This 
+package is then queried for what metaclasses it should use. The possible 
+metaclass values are:
+
+=over
+
+=item B<metaclass> 
+
+This defaults to C<Moose::Meta::Class>.
+
+=item B<attribute_metaclass>
+
+=item B<instance_metaclass>
+
+=item B<method_metaclass>
+
+=back
+
+For examples of what a Policy actually looks like see the examples in 
+C<Moose::Policy::> and the test suite. More docs to come on this later (probably 
+a cookbook or something).
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=back
+
+=head1 FUTURE PLANS
+
+As I said above, this is the first release and it is by no means feature complete. 
+There are a number of thoughts on the future direction of this module. Here are 
+some random thoughts on that, in no particular order.
+
+=over 4
+
+=item Make set of policy roles
+
+Roles are an excellent way to combine sets of behaviors together into one, and 
+custom metaclasses are actually better composed by roles then by inheritence. 
+The ideal situation is that this module will provide a set of roles which can be 
+used to compose you meta-policy with relative ease.
+
+=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 at iinteractive.comE<gt>
+
+Eric Wilhelm
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 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
+

Added: branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/FollowPBP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/FollowPBP.pm?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/FollowPBP.pm (added)
+++ branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/FollowPBP.pm Wed May 28 13:27:38 2008
@@ -1,0 +1,77 @@
+
+package Moose::Policy::FollowPBP;
+
+use constant attribute_metaclass => 'Moose::Policy::FollowPBP::Attribute';
+
+package Moose::Policy::FollowPBP::Attribute;
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+before '_process_options' => sub {
+    my ($class, $name, $options) = @_;
+    # NOTE:
+    # If is has been specified, and 
+    # we don't have a reader or writer
+    # Of couse this is an odd case, but
+    # we better test for it anyway.
+    if (exists $options->{is} && !(exists $options->{reader} || exists $options->{writer})) {
+        if ($options->{is} eq 'ro') {
+            $options->{reader} = 'get_' . $name;
+        }
+        elsif ($options->{is} eq 'rw') {
+            $options->{reader} = 'get_' . $name;
+            $options->{writer} = 'set_' . $name;
+        }
+        delete $options->{is};
+    }
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME 
+
+Moose::Policy::FollowPBP - Follow the recomendations in Perl Best Practices
+
+=head1 SYNOPSIS
+
+  package Foo;
+  
+  use Moose::Policy 'Moose::Policy::FollowPBP';
+  use Moose;
+  
+  has 'bar' => (is => 'rw', default => 'Foo::bar');
+  has 'baz' => (is => 'ro', default => 'Foo::baz');
+  
+  # Foo now has (get, set)_bar methods as well as get_baz
+
+=head1 DESCRIPTION
+
+This meta-policy changes Moose's default accossor-naming behavior to
+follow the recommendations found in Damian Conway's book I<Perl Best
+Practices>.
+
+=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 at iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 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

Added: branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/JavaAccessors.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/JavaAccessors.pm?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/JavaAccessors.pm (added)
+++ branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/JavaAccessors.pm Wed May 28 13:27:38 2008
@@ -1,0 +1,83 @@
+
+package Moose::Policy::JavaAccessors;
+
+use constant attribute_metaclass => 'Moose::Policy::JavaAccessors::Attribute';
+
+package Moose::Policy::JavaAccessors::Attribute;
+use Moose;
+
+extends 'Moose::Meta::Attribute';
+
+before '_process_options' => sub {
+    my ($class, $name, $options) = @_;
+    # NOTE:
+    # If is has been specified, and 
+    # we don't have a reader or writer
+    # Of couse this is an odd case, but
+    # we better test for it anyway.
+    if (exists $options->{is} && !(exists $options->{reader} || exists $options->{writer})) {
+        if ($options->{is} eq 'ro') {
+            $options->{reader} = 'get' . ucfirst($name);
+        }
+        elsif ($options->{is} eq 'rw') {
+            $options->{reader} = 'get' . ucfirst($name);
+            $options->{writer} = 'set' . ucfirst($name);
+        }
+        delete $options->{is};
+    }
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME 
+
+Moose::Policy::JavaAccessors - BeCause EveryOne Loves CamelCase
+
+=head1 SYNOPSIS
+  
+  package Foo;
+  
+  use Moose::Policy 'Moose::Policy::JavaAccessors';
+  use Moose;
+  
+  has 'bar' => (is => 'rw', default => 'Foo::bar');
+  has 'baz' => (is => 'ro', default => 'Foo::baz');
+  
+  # Foo now has (get, set)Bar methods as well as getBaz
+
+=head1 DESCRIPTION
+
+This meta-policy changes the behavior of Moose's default behavior in 
+regard to  accessors to follow Java convention and use CamelCase.
+
+=head1 CAVEAT
+
+This does a very niave conversion to CamelCase, basically it just 
+runs C<ucfirst> on the attribute name. Since I don't use CamelCase 
+(at least not anymore), this is good enough. If you really want to 
+use this, and need a more sophisicated conversion, patches welcome :)
+
+=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 at iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 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

Added: branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/SingleInheritence.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/SingleInheritence.pm?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/SingleInheritence.pm (added)
+++ branches/upstream/libmoose-policy-perl/current/lib/Moose/Policy/SingleInheritence.pm Wed May 28 13:27:38 2008
@@ -1,0 +1,75 @@
+
+package Moose::Policy::SingleInheritence;
+
+use constant metaclass => 'Moose::Policy::SingleInheritence::MetaClass';
+
+package Moose::Policy::SingleInheritence::MetaClass;
+use Moose;
+
+extends 'Moose::Meta::Class';
+
+before 'superclasses' => sub {
+    my ($self, @superclasses) = @_;
+    confess 'Moose::Policy::SingleInheritence in effect for ' . 
+             $self->name . ', only single inheritence is allowed'
+         if scalar @superclasses > 1;
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME 
+
+Moose::Policy::SingleInheritence - Why would you ever need more than one?
+
+=head1 SYNOPSIS
+
+  package Foo;
+  
+  use Moose::Policy 'Moose::Policy::SingleInheritence';
+  use Moose;
+  
+  package Bar;
+  
+  use Moose::Policy 'Moose::Policy::SingleInheritence';
+  use Moose;
+  
+  package Foo::Bar;
+  
+  use Moose::Policy 'Moose::Policy::SingleInheritence';
+  use Moose;
+  
+  extends 'Foo', 'Bar';  # BOOM!!!!
+
+=head1 DESCRIPTION
+
+This module restricts Moose's C<extends> keyword so that you can only assign 
+a single superclass. 
+
+This is mostly an example of how you can restrict behavior with meta-policies 
+in addition to extending and/or customising them. However, sometimes enforcing 
+a policy like this can be a good thing.
+
+=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 at iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 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

Added: branches/upstream/libmoose-policy-perl/current/t/000_load.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/000_load.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/000_load.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/000_load.t Wed May 28 13:27:38 2008
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok('Moose::Policy');           
+}

Added: branches/upstream/libmoose-policy-perl/current/t/001_basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/001_basic.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/001_basic.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/001_basic.t Wed May 28 13:27:38 2008
@@ -1,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+{
+    package My::Moose::Meta::Attribute;
+    use Moose;
+
+    extends 'Moose::Meta::Attribute';
+
+    # this method (mostly stolen from M::M::Attribute) just rebuilds the
+    # options so anything with 'is' gets PBP accessors
+    before '_process_options' => sub {
+        my ($class, $name, $options) = @_;
+        if (exists $options->{is}) {
+            if ($options->{is} eq 'ro') {
+                $options->{reader} = 'get_' . $name;
+            }
+            elsif ($options->{is} eq 'rw') {
+                $options->{reader} = 'get_' . $name;
+                $options->{writer} = 'set_' . $name;
+            }
+            delete $options->{is};
+        }
+
+        $class->SUPER::_process_options($name, $options);
+    }
+}
+
+{
+    package My::Moose::Policy;
+    # policy just specifies metaclass delegates
+    use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
+}
+
+{
+    package Foo;
+
+    use Moose::Policy 'My::Moose::Policy';
+    use Moose;
+
+    has 'bar' => (is => 'rw', default => 'Foo::bar');
+    has 'baz' => (is => 'ro', default => 'Foo::baz');
+}
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'My::Moose::Meta::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Foo->meta->get_attribute('bar'), 'My::Moose::Meta::Attribute');
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+can_ok($foo, 'get_bar');
+can_ok($foo, 'set_bar');
+
+can_ok($foo, 'get_baz');
+ok(! $foo->can('set_baz'), 'without setter');
+
+is($foo->get_bar, 'Foo::bar', '... got the right default value');
+is($foo->get_baz, 'Foo::baz', '... got the right default value');
+
+# vim:ts=4:sw=4:et:sta

Added: branches/upstream/libmoose-policy-perl/current/t/002_dynamic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/002_dynamic.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/002_dynamic.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/002_dynamic.t Wed May 28 13:27:38 2008
@@ -1,0 +1,89 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+BEGIN {
+    package My::Plain::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+}
+BEGIN {
+    package My::Bar::Attribute;
+    use Moose;
+    extends 'Moose::Meta::Attribute';
+}
+BEGIN {
+    package My::Plain::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+}
+BEGIN {
+    package My::Bar::Class;
+    use Moose;
+    extends 'Moose::Meta::Class';
+}
+BEGIN {
+    package My::Moose::Policy;
+    # because writing subs is hard
+    my %pkg_map = (
+        qw(metaclass Class),
+        qw(attribute_metaclass  Attribute),
+        # TODO these:
+        # qw(method_metaclass Method),
+        # qw(instance_metaclass Instance),
+    );
+    foreach my $subname (keys(%pkg_map)) {
+        my $pkg = $pkg_map{$subname};
+        my $sub = sub {
+            my $self = shift;
+            my ($caller) = @_;
+            return('My::Bar::' . $pkg)
+                if($caller =~ m/^Bar(?:::|$)/);
+            return 'My::Plain::' . $pkg;
+        };
+        no strict 'refs';
+        *{$subname} = $sub;
+    }
+}
+{
+    package Foo;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bar;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bars;
+    use Moose::Policy 'My::Moose::Policy';
+}
+{
+    package Bar::None;
+    use Moose::Policy 'My::Moose::Policy';
+}
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'My::Plain::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bar->meta, 'Moose::Meta::Class');
+isa_ok(Bar->meta, 'My::Bar::Class');
+is(Bar->meta->attribute_metaclass, 'My::Bar::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bars->meta, 'Moose::Meta::Class');
+isa_ok(Bars->meta, 'My::Plain::Class');
+is(Bars->meta->attribute_metaclass, 'My::Plain::Attribute',
+    '... got our custom attr metaclass');
+
+isa_ok(Bar::None->meta, 'Moose::Meta::Class');
+isa_ok(Bar::None->meta, 'My::Bar::Class');
+is(Bar::None->meta->attribute_metaclass, 'My::Bar::Attribute',
+    '... got our custom attr metaclass');

Added: branches/upstream/libmoose-policy-perl/current/t/003_saidso.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/003_saidso.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/003_saidso.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/003_saidso.t Wed May 28 13:27:38 2008
@@ -1,0 +1,96 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 22;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+{
+    package My::Moose::Meta::Attribute;
+    use Moose;
+
+    extends 'Moose::Meta::Attribute';
+
+    # this one gives you PBP accessors
+    # and gives you accessors unless you said otherwise
+    sub _process_options {
+        my ($class, $name, $options) = @_;
+        my $is = delete $options->{is} || 'rw';
+        if($is eq 'ro') {
+            $options->{reader} = 'get_' . $name;
+        }
+        elsif($is eq 'rw') {
+            $options->{reader} = 'get_' . $name;
+            $options->{writer} = 'set_' . $name;
+        }
+        elsif($is eq 'no') {
+            # only way to not get accessors
+        }
+        else {
+            # pass it through and let him deal with it
+            $options->{is} = $is;
+        }
+
+        $class->SUPER::_process_options($name, $options);
+    }
+}
+
+{
+    package My::Moose::Policy;
+    # policy just specifies metaclass delegates
+    use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
+}
+
+my $oops;
+{
+    package Foo;
+
+    use Moose::Policy 'My::Moose::Policy';
+    use Moose;
+
+    has 'bar' => (default => 'Foo::bar');
+    has 'baz' => (default => 'Foo::baz');
+    has 'bop' => (is => 'no', default => 'woot');
+    eval { has 'oops' => (is => 'thbbbt'); };
+    $oops = $@;
+}
+
+ok($oops, "thbbt got booted out");
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'My::Moose::Meta::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Foo->meta->get_attribute('bar'), 'My::Moose::Meta::Attribute');
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+can_ok($foo, 'get_bar');
+can_ok($foo, 'set_bar');
+
+can_ok($foo, 'get_baz');
+can_ok($foo, 'set_baz');
+
+ok(! $foo->can('bop'), 'do not want any bop');
+ok(! $foo->can('get_bop'), 'do not want any bop');
+ok(! $foo->can('set_bop'), 'do not want any bop');
+
+ok(! $foo->can('oops'), 'do not want any oops');
+ok(! $foo->can('get_oops'), 'do not want any oops');
+ok(! $foo->can('set_oops'), 'do not want any oops');
+
+is($foo->get_bar, 'Foo::bar', '... got the right default bar value');
+is($foo->get_baz, 'Foo::baz', '... got the right default baz value');
+ok(exists($foo->{bop}), 'we have bop');
+ok(! exists($foo->{oops}), 'do not want to have an oops');
+is($foo->{bop}, 'woot',     '... got the right default bop value');
+
+$foo->set_bar('the new bar');
+is($foo->get_bar, 'the new bar', 'setter works');
+
+# vim:ts=4:sw=4:et:sta
+

Added: branches/upstream/libmoose-policy-perl/current/t/010_FollowPBP_test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/010_FollowPBP_test.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/010_FollowPBP_test.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/010_FollowPBP_test.t Wed May 28 13:27:38 2008
@@ -1,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 28;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+{
+    package Foo;
+
+    use Moose::Policy 'Moose::Policy::FollowPBP';
+    use Moose;
+
+    has 'bar' => (is => 'rw', default => 'Foo::bar');
+    has 'baz' => (is => 'ro', default => 'Foo::baz');
+}
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'Moose::Policy::FollowPBP::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Foo->meta->get_attribute('bar'), 'Moose::Policy::FollowPBP::Attribute');
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+can_ok($foo, 'get_bar');
+can_ok($foo, 'set_bar');
+
+can_ok($foo, 'get_baz');
+ok(! $foo->can('set_baz'), 'without setter');
+
+is($foo->get_bar, 'Foo::bar', '... got the right default value');
+is($foo->get_baz, 'Foo::baz', '... got the right default value');
+
+{
+    package Bar;
+    use Moose::Policy 'Moose::Policy::FollowPBP';    
+    use Moose;
+    
+    extends 'Foo';
+
+    has 'boing' => (is => 'rw', default => 'Bar::boing');
+}
+
+isa_ok(Bar->meta, 'Moose::Meta::Class');
+is(Bar->meta->attribute_metaclass, 'Moose::Policy::FollowPBP::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Bar->meta->get_attribute('boing'), 'Moose::Policy::FollowPBP::Attribute');
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
+
+can_ok($bar, 'get_boing');
+can_ok($bar, 'set_boing');
+
+is($bar->get_boing, 'Bar::boing', '... got the right default value');
+$bar->set_boing('Woot!');
+is($bar->get_boing, 'Woot!', '... got the right changed value');
+
+{
+    package Baz;
+    use Moose;
+    
+    extends 'Bar';
+
+    has 'bling' => (is => 'ro', default => 'Baz::bling');
+}
+
+isa_ok(Baz->meta, 'Moose::Meta::Class');
+is(Baz->meta->attribute_metaclass, 'Moose::Meta::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Baz->meta->get_attribute('bling'), 'Moose::Meta::Attribute');
+
+my $baz = Baz->new;
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Bar');
+isa_ok($baz, 'Foo');
+
+can_ok($baz, 'bling');
+
+is($baz->bling, 'Baz::bling', '... got the right default value');

Added: branches/upstream/libmoose-policy-perl/current/t/011_JavaAccessors_test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/011_JavaAccessors_test.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/011_JavaAccessors_test.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/011_JavaAccessors_test.t Wed May 28 13:27:38 2008
@@ -1,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+{
+    package Foo;
+
+    use Moose::Policy 'Moose::Policy::JavaAccessors';
+    use Moose;
+
+    has 'bar' => (is => 'rw', default => 'Foo::bar');
+    has 'baz' => (is => 'ro', default => 'Foo::baz');
+}
+
+isa_ok(Foo->meta, 'Moose::Meta::Class');
+is(Foo->meta->attribute_metaclass, 'Moose::Policy::JavaAccessors::Attribute', '... got our custom attr metaclass');
+
+isa_ok(Foo->meta->get_attribute('bar'), 'Moose::Policy::JavaAccessors::Attribute');
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+can_ok($foo, 'getBar');
+can_ok($foo, 'setBar');
+
+can_ok($foo, 'getBaz');
+ok(! $foo->can('setBaz'), 'without setter');
+
+is($foo->getBar, 'Foo::bar', '... got the right default value');
+is($foo->getBaz, 'Foo::baz', '... got the right default value');
+

Added: branches/upstream/libmoose-policy-perl/current/t/020_SingleInheritence_test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/020_SingleInheritence_test.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/020_SingleInheritence_test.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/020_SingleInheritence_test.t Wed May 28 13:27:38 2008
@@ -1,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose::Policy');
+}
+
+{
+    package Foo;
+    use Moose::Policy 'Moose::Policy::SingleInheritence';
+    use Moose;
+    
+    package Bar;
+    use Moose::Policy 'Moose::Policy::SingleInheritence';
+    use Moose;    
+
+    extends 'Foo';
+    
+    package Baz;
+    use Moose::Policy 'Moose::Policy::SingleInheritence';    
+    use Moose;    
+    
+    ::dies_ok {
+        extends 'Foo', 'Bar';
+    } '... violating the policy';
+}
+

Added: branches/upstream/libmoose-policy-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/pod.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/pod.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/pod.t Wed May 28 13:27:38 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();

Added: branches/upstream/libmoose-policy-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmoose-policy-perl/current/t/pod_coverage.t?rev=20463&op=file
==============================================================================
--- branches/upstream/libmoose-policy-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libmoose-policy-perl/current/t/pod_coverage.t Wed May 28 13:27:38 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+
+all_pod_coverage_ok();




More information about the Pkg-perl-cvs-commits mailing list