etc), mostly the code copied verbatim from recipes.
use Test::Exception;
{
- package Point;
- use Moose;
-
- has 'x' => (isa => 'Int', is => 'ro');
- has 'y' => (isa => 'Int', is => 'rw');
-
- sub clear {
- my $self = shift;
- $self->{x} = 0;
- $self->y(0);
- }
-
- __PACKAGE__->meta->make_immutable(debug => 0);
-}{
- package Point3D;
- use Moose;
-
- extends 'Point';
-
- has 'z' => (isa => 'Int');
-
- after 'clear' => sub {
- my $self = shift;
- $self->{z} = 0;
- };
-
- __PACKAGE__->meta->make_immutable(debug => 0);
+ package Point;
+ use Moose;
+
+ has 'x' => ( isa => 'Int', is => 'ro' );
+ has 'y' => ( isa => 'Int', is => 'rw' );
+
+ sub clear {
+ my $self = shift;
+ $self->{x} = 0;
+ $self->y(0);
+ }
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
+}
+
+{
+ package Point3D;
+ use Moose;
+
+ extends 'Point';
+
+ has 'z' => ( isa => 'Int' );
+
+ after 'clear' => sub {
+ my $self = shift;
+ $self->{z} = 0;
+ };
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
}
my $point = Point->new(x => 1, y => 2);
{
package BankAccount;
use Moose;
-
- has 'balance' => (isa => 'Num', is => 'rw', default => 0);
+
+ has 'balance' => ( isa => 'Num', is => 'rw', default => 0 );
sub deposit {
- my ($self, $amount) = @_;
- $self->balance($self->balance + $amount);
+ my ( $self, $amount ) = @_;
+ $self->balance( $self->balance + $amount );
}
-
+
sub withdraw {
- my ($self, $amount) = @_;
+ my ( $self, $amount ) = @_;
my $current_balance = $self->balance();
- ($current_balance >= $amount)
+ ( $current_balance >= $amount )
|| confess "Account overdrawn";
- $self->balance($current_balance - $amount);
+ $self->balance( $current_balance - $amount );
}
-
- __PACKAGE__->meta->make_immutable(debug => 0);
-}{
- package CheckingAccount;
- use Moose;
-
- extends 'BankAccount';
-
- has 'overdraft_account' => (isa => 'BankAccount', is => 'rw');
-
- before 'withdraw' => sub {
- my ($self, $amount) = @_;
- my $overdraft_amount = $amount - $self->balance();
- if ($self->overdraft_account && $overdraft_amount > 0) {
- $self->overdraft_account->withdraw($overdraft_amount);
- $self->deposit($overdraft_amount);
- }
- };
-
- __PACKAGE__->meta->make_immutable(debug => 0);
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
+}
+
+{
+ package CheckingAccount;
+ use Moose;
+
+ extends 'BankAccount';
+
+ has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
+
+ before 'withdraw' => sub {
+ my ( $self, $amount ) = @_;
+ my $overdraft_amount = $amount - $self->balance();
+ if ( $self->overdraft_account && $overdraft_amount > 0 ) {
+ $self->overdraft_account->withdraw($overdraft_amount);
+ $self->deposit($overdraft_amount);
+ }
+ };
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
}
my $savings_account = BankAccount->new(balance => 250);
package BinaryTree;
use Moose;
- has 'node' => (is => 'rw', isa => 'Any');
+ has 'node' => ( is => 'rw', isa => 'Any' );
has 'parent' => (
- is => 'rw',
- isa => 'BinaryTree',
+ is => 'rw',
+ isa => 'BinaryTree',
predicate => 'has_parent',
- weak_ref => 1,
+ weak_ref => 1,
);
has 'left' => (
- is => 'rw',
- isa => 'BinaryTree',
- predicate => 'has_left',
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_left',
lazy => 1,
- default => sub { BinaryTree->new(parent => $_[0]) },
+ default => sub { BinaryTree->new( parent => $_[0] ) },
);
has 'right' => (
- is => 'rw',
- isa => 'BinaryTree',
- predicate => 'has_right',
- lazy => 1,
- default => sub { BinaryTree->new(parent => $_[0]) },
+ is => 'rw',
+ isa => 'BinaryTree',
+ predicate => 'has_right',
+ lazy => 1,
+ default => sub { BinaryTree->new( parent => $_[0] ) },
);
before 'right', 'left' => sub {
- my ($self, $tree) = @_;
- $tree->parent($self) if defined $tree;
- };
-
- __PACKAGE__->meta->make_immutable(debug => 0);
+ my ( $self, $tree ) = @_;
+ $tree->parent($self) if defined $tree;
+ };
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
}
my $root = BinaryTree->new(node => 'root');
use Test::Exception;
{
- package Request;
- use Moose;
+ package Request;
+ use Moose;
use Moose::Util::TypeConstraints;
-
- use HTTP::Headers ();
- use Params::Coerce ();
- use URI ();
-
- subtype Header
- => as Object
- => where { $_->isa('HTTP::Headers') };
-
- coerce Header
- => from ArrayRef
- => via { HTTP::Headers->new( @{ $_ } ) }
- => from HashRef
- => via { HTTP::Headers->new( %{ $_ } ) };
-
- subtype Uri
- => as Object
- => where { $_->isa('URI') };
-
- coerce Uri
- => from Object
- => via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) }
- => from Str
- => via { URI->new( $_, 'http' ) };
-
- subtype Protocol
- => as Str
- => where { /^HTTP\/[0-9]\.[0-9]$/ };
-
-
- has 'base' => (is => 'rw', isa => 'Uri', coerce => 1);
- has 'url' => (is => 'rw', isa => 'Uri', coerce => 1);
- has 'method' => (is => 'rw', isa => 'Str');
- has 'protocol' => (is => 'rw', isa => 'Protocol');
- has 'headers' => (
- is => 'rw',
- isa => 'Header',
- coerce => 1,
- default => sub { HTTP::Headers->new }
+
+ use HTTP::Headers ();
+ use Params::Coerce ();
+ use URI ();
+
+ subtype Header => as Object => where { $_->isa('HTTP::Headers') };
+
+ coerce Header => from ArrayRef => via { HTTP::Headers->new( @{$_} ) } =>
+ from HashRef => via { HTTP::Headers->new( %{$_} ) };
+
+ subtype Uri => as Object => where { $_->isa('URI') };
+
+ coerce Uri => from Object =>
+ via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) } =>
+ from Str => via { URI->new( $_, 'http' ) };
+
+ subtype Protocol => as Str => where {/^HTTP\/[0-9]\.[0-9]$/};
+
+ has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+ has 'url' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+ has 'method' => ( is => 'rw', isa => 'Str' );
+ has 'protocol' => ( is => 'rw', isa => 'Protocol' );
+ has 'headers' => (
+ is => 'rw',
+ isa => 'Header',
+ coerce => 1,
+ default => sub { HTTP::Headers->new }
);
-
- __PACKAGE__->meta->make_immutable(debug => 0);
+
+ __PACKAGE__->meta->make_immutable( debug => 0 );
}
my $r = Request->new;
{
- package FooRole;
- our $VERSION = '0.01';
- sub foo { 'FooRole::foo' }
+ package FooRole;
+ our $VERSION = '0.01';
+ sub foo {'FooRole::foo'}
}
{
- package Foo;
- use Moose;
-
- #two checks because the inlined methods are different when
- #there is a TC present.
- has 'foos' => (is => 'ro', lazy_build => 1);
- has 'bars' => (isa => 'Str', is => 'ro', lazy_build => 1);
- has 'bazes' => (isa => 'Str', is => 'ro', builder => '_build_bazes');
- sub _build_foos { "many foos" }
- sub _build_bars { "many bars" }
- sub _build_bazes { "many bazes" }
+ package Foo;
+ use Moose;
+
+ #two checks because the inlined methods are different when
+ #there is a TC present.
+ has 'foos' => ( is => 'ro', lazy_build => 1 );
+ has 'bars' => ( isa => 'Str', is => 'ro', lazy_build => 1 );
+ has 'bazes' => ( isa => 'Str', is => 'ro', builder => '_build_bazes' );
+ sub _build_foos {"many foos"}
+ sub _build_bars {"many bars"}
+ sub _build_bazes {"many bazes"}
}
{
- my $foo_role = Moose::Meta::Role->initialize('FooRole');
- my $meta = Foo->meta;
-
- lives_ok{ Foo->new } "lazy_build works";
- is(Foo->new->foos, 'many foos' , "correct value for 'foos' before inlining constructor");
- is(Foo->new->bars, 'many bars' , "correct value for 'bars' before inlining constructor");
- is(Foo->new->bazes, 'many bazes' , "correct value for 'bazes' before inlining constructor");
- lives_ok{ $meta->make_immutable } "Foo is imutable";
- lives_ok{ $meta->identifier } "->identifier on metaclass lives";
- dies_ok{ $meta->add_role($foo_role) } "Add Role is locked";
- lives_ok{ Foo->new } "Inlined constructor works with lazy_build";
- is(Foo->new->foos, 'many foos' , "correct value for 'foos' after inlining constructor");
- is(Foo->new->bars, 'many bars' , "correct value for 'bars' after inlining constructor");
- is(Foo->new->bazes, 'many bazes' , "correct value for 'bazes' after inlining constructor");
- lives_ok{ $meta->make_mutable } "Foo is mutable";
- lives_ok{ $meta->add_role($foo_role) } "Add Role is unlocked";
-
+ my $foo_role = Moose::Meta::Role->initialize('FooRole');
+ my $meta = Foo->meta;
+
+ lives_ok { Foo->new } "lazy_build works";
+ is( Foo->new->foos, 'many foos',
+ "correct value for 'foos' before inlining constructor" );
+ is( Foo->new->bars, 'many bars',
+ "correct value for 'bars' before inlining constructor" );
+ is( Foo->new->bazes, 'many bazes',
+ "correct value for 'bazes' before inlining constructor" );
+ lives_ok { $meta->make_immutable } "Foo is imutable";
+ lives_ok { $meta->identifier } "->identifier on metaclass lives";
+ dies_ok { $meta->add_role($foo_role) } "Add Role is locked";
+ lives_ok { Foo->new } "Inlined constructor works with lazy_build";
+ is( Foo->new->foos, 'many foos',
+ "correct value for 'foos' after inlining constructor" );
+ is( Foo->new->bars, 'many bars',
+ "correct value for 'bars' after inlining constructor" );
+ is( Foo->new->bazes, 'many bazes',
+ "correct value for 'bazes' after inlining constructor" );
+ lives_ok { $meta->make_mutable } "Foo is mutable";
+ lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
}