Skip to content

Instantly share code, notes, and snippets.

@gardejo

gardejo/.gitignore

Created November 9, 2009 16:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save gardejo/230058 to your computer and use it in GitHub Desktop.
Save gardejo/230058 to your computer and use it in GitHub Desktop.
Download ZIP
feasibility study on memoization and dynamic type constraints with Moose
Raw
.gitignore
.*
!.gitignore
Makefile*
!Makefile.PL
META.yml
blib
build
inc
pm_to_blib
MANIFEST*
!MANIFEST.SKIP
Amikeco-Value-Activity-Level-*
*.bs
cover_db
Raw
00_role_real.t
#!perl
use strict;
use warnings;
use lib 't/lib';
use Test::Amikeco::Value::Activity::Level::Role::RealType;
Test::Amikeco::Value::Activity::Level::Role::RealType->runtests;
__END__
Raw
01_role_real_explicit.t
#!perl
use strict;
use warnings;
use lib 't/lib';
use Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit;
Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit->runtests;
__END__
Raw
02_role_pseudo.t
#!perl
use strict;
use warnings;
use lib 't/lib';
use Test::Amikeco::Value::Activity::Level::Role::PseudoType;
Test::Amikeco::Value::Activity::Level::Role::PseudoType->runtests;
__END__
Raw
10_subclass_real.t
#!perl
use strict;
use warnings;
use lib 't/lib';
use Test::Amikeco::Value::Activity::Level::Subclass::RealType;
Test::Amikeco::Value::Activity::Level::Subclass::RealType->runtests;
__END__
Raw
README
This is feasibility study on memoization and dynamic type constraints with Moose.
See also gist: 232025
git://gist.github.com/232025.git
http://gist.github.com/232025
================================================================
1) 動的に型を作成するための実現可能性調査
そもそも型というものはグローバルなものであって、「動的な型」という言葉自体が、
Mooseクラスの契約的APIにそぐわない感があるけれども。
----------------------------------------------------------------
最終的には
__PACKAGE__->meta->add_attribute(
'+foobar' => (
isa => ...,
),
);
ということで実現出来た。
__PACKAGE__->meta->get_attribute('foobar')->type_constraint(...);
は不可。type_constraintアトリビュートは読み込み専用であるため。
バリデーションで「実際のクラス(consumer class)の」クラスメソッドを使わざるを
得ないので、MyApp::Typesなどに書くことは出来ない（はず）。
「ロールの」クラスメソッドや「基底クラスの」クラスメソッドでしかありえないので。動的に使うためには、BUILDでフックして「実際のクラス」を教えてあげる必要がある。
動的な型生成を諦めるなら、疑似型(Pseudo Type)という方言を使ったけれども、
要は手動でバリデーションコードを書くしかなさそう。
静的に生成する場合には、「実際のクラス」でお行儀よく
has '+name' => ( isa => ... );
する方法もあるが、それをいちいち各サブクラスで書いて回るのは面倒。
alignmentとdefaultという、クラス変数的なメソッドのみを書きたい。
手動バリデーションも、静的型生成も、いずれもDRYではない。
従って動的な型生成を選択することにした。
Attribute::Memoizeと連携出来るのかどうかは、今後の検討課題としたい。
----------------------------------------------------------------
Amikeco::Value::LevelLike::Role::RealTypeロールをAmikeco::Value::LevelLike
として使うようにしたい。
================================================================
2) MemoizeをMooseロールで使う方法
moose@perl.orgより。MSTことMatt S Troutさんの回答がありました。
http://thread.gmane.org/gmane.comp.lang.perl.moose/793/focus=797
Raw
Base.pm
package Test::Amikeco::Value::Activity::Level::Base;
# ****************************************************************
# pragma(s)
# ****************************************************************
use strict;
use warnings;
# ****************************************************************
# superclass(es)
# ****************************************************************
use base qw(
Test::Class
);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
use Test::Exception;
use Test::More;
# use Test::Most;
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub _level_numbers {
return sort { $a <=> $b } qw(0 2 4 8 9 100);
# oops, the logic below is same as tested class...
# return sort { $a <=> $b } values %{ { $_[0]->_alignment } };
}
sub _alignment {
return (
inactive => 0,
normal_weekday => 2,
core_weekday => 4,
8 => 8,
holiday => 9,
100 => 100,
);
}
sub _message_pattern {
my ($self, $key) = @_;
my %message_pattern = (
non_enumrated_name
=> qr{^Attribute \(name\) does not pass the type constraint},
non_enumrated_number
=> qr{^Attribute \(number\) does not pass the type constraint},
dual_wield_construction
=> qr{^Initialization argument must be any one of name or number},
);
return $key ? $message_pattern{$key} : %message_pattern;
}
# ****************************************************************
# utility(-ies)
# ****************************************************************
sub _random_level {
my $self = shift;
my @level_numbers = $self->_level_numbers;
return $level_numbers[ int( rand($#level_numbers) ) ];
}
# ****************************************************************
# test(s)
# ****************************************************************
sub _setup : Test(setup) {
my $self = shift;
$self->{class} = $self->_target_class;
$self->{instance} = $self->{class}->new;
return;
}
sub test_to_name : Tests(no_plan) {
my $self = shift;
my %alignment = $self->_alignment;
while (my ($name, $number) = each %alignment) {
is $self->{class}->to_name($number), $name
=> sprintf('to_name(%d) is (%s) ok', $number, $name);
}
return;
}
sub test_to_number : Tests(no_plan) {
my $self = shift;
my %alignment = $self->_alignment;
while (my ($name, $number) = each %alignment) {
is $self->{class}->to_number($name), $number
=> sprintf('to_number(%s) is (%d) ok', $name, $number);
}
return;
}
sub test_name : Tests(no_plan) {
my $self = shift;
my %alignment = $self->_alignment;
while (my ($name, $number) = each %alignment) {
$self->{instance} = $self->{class}->new(
name => $name,
);
is $self->{instance}->name, $name
=> sprintf('get name (%s) ok', $name);
is $self->{instance}->number, $number
=> sprintf('get number (%d) ok', $number);
is $self->{instance}->name($name), $name
=> sprintf('set name (%s) ok', $name);
is $self->{instance}->name, $name
=> sprintf('get name (%s) ok', $name);
is $self->{instance}->number, $number
=> sprintf('get number (%d) ok', $number);
}
return;
}
sub test_number : Tests(no_plan) {
my $self = shift;
my %alignment = reverse $self->_alignment;
while (my ($number, $name) = each %alignment) {
$self->{instance} = $self->{class}->new(
number => $number,
);
is $self->{instance}->number, $number
=> sprintf('get number (%d) ok', $number);
is $self->{instance}->name, $name
=> sprintf('get name (%s) ok', $name);
is $self->{instance}->number($number), $number
=> sprintf('set number (%d) ok', $number);
is $self->{instance}->number, $number
=> sprintf('get number (%d) ok', $number);
is $self->{instance}->name, $name
=> sprintf('get name (%s) ok', $name);
}
return;
}
sub test_non_enumrated_name : Tests(3) {
my $self = shift;
my $message_pattern = $self->_message_pattern('non_enumrated_name');
throws_ok {
$self->{class}->new(
name => '!!JUNK!!',
);
} $message_pattern
=> q{non-enumrated name ('!!JUNK!!') throws exception};
throws_ok {
$self->{instance}->name('!!JUNK!!');
} $message_pattern
=> q{non-enumrated name ('!!JUNK!!') throws exception};
throws_ok {
$self->{instance}->name(undef);
} $message_pattern
=> q{non-enumrated name (undef) throws exception};
return;
}
sub test_non_enumrated_number : Tests(3) {
my $self = shift;
my $message_pattern = $self->_message_pattern('non_enumrated_number');
throws_ok {
$self->{class}->new(
number => 42,
);
} $message_pattern
=> q{non-enumrated name (42) throws exception};
throws_ok {
$self->{instance}->number(42);
} $message_pattern
=> q{non-enumrated number (42) throws exception};
throws_ok {
$self->{instance}->number(undef);
} $message_pattern
=> q{non-enumrated number (undef) throws exception};
return;
}
sub test_dual_wield_construction : Tests(1) {
my $self = shift;
my $message_pattern = $self->_message_pattern('dual_wield_construction');
my @level_numbers = $self->_level_numbers;
throws_ok {
$self->{class}->new(
number => $level_numbers[0],
name => $self->{class}->to_name($level_numbers[0]),
);
} $message_pattern
=> q{dual_wield_construction};
return;
}
sub test_inflate : Tests(no_plan) {
my $self = shift;
foreach my $level_number ($self->_level_numbers) {
$self->{instance} = $self->{class}->inflate($level_number);
is $self->{instance}->number, $level_number
=> sprintf('inflate (%d) ok', $level_number);
}
return;
}
sub test_deflate : Tests(no_plan) {
my $self = shift;
foreach my $level_number ($self->_level_numbers) {
$self->{instance}->number($level_number);
is $self->{instance}->deflate, $level_number
=> sprintf('deflate (%d) ok', $level_number);
}
return;
}
sub test_promote : Tests(no_plan) {
my $self = shift;
my @level_numbers = $self->_level_numbers;
$self->{instance} = $self->{class}->new(
number => $level_numbers[0],
);
my $level_index = 0;
while ($level_index < $#level_numbers) {
$self->{instance}->promote;
is $self->{instance}->number, $level_numbers[$level_index + 1]
=> sprintf(
'promote (%d to %d) ok',
$level_numbers[$level_index],
$level_numbers[$level_index + 1],
);
$level_index++;
}
$self->{instance}->promote;
is $self->{instance}->number, $level_numbers[$level_index]
=> sprintf(
'does not promote (%d) ok',
$level_numbers[$level_index],
);
return;
}
sub test_demote : Tests(no_plan) {
my $self = shift;
my @level_numbers = $self->_level_numbers;
$self->{instance} = $self->{class}->new(
number => $level_numbers[-1],
);
my $level_index = $#level_numbers;
while ($level_index > 0) {
$self->{instance}->demote;
is $self->{instance}->number, $level_numbers[$level_index - 1]
=> sprintf(
'demote (%d to %d) ok',
$level_numbers[$level_index],
$level_numbers[$level_index - 1],
);
$level_index--;
}
$self->{instance}->demote;
is $self->{instance}->number, $level_numbers[$level_index]
=> sprintf(
'does not demote (%d) ok',
$level_numbers[$level_index],
);
return;
}
sub test_maximum : Tests(4) {
my $self = shift;
is $self->{instance}->maximize, ($self->_level_numbers)[-1]
=> 'maximize ok';
ok $self->{instance}->is_maximum
=> 'maximum ok';
is $self->{instance}->number, $self->{class}->maximum_number
=> 'maximum_number ok';
is $self->{instance}->name, $self->{class}->maximum_name
=> 'maximum_name ok';
return;
}
sub test_minimum : Tests(4) {
my $self = shift;
is $self->{instance}->minimize, ($self->_level_numbers)[0]
=> 'minimize ok';
ok $self->{instance}->is_minimum
=> 'is_minimum ok';
is $self->{instance}->number, $self->{class}->minimum_number
=> 'minimum_number ok';
is $self->{instance}->name, $self->{class}->minimum_name
=> 'minimum_name ok';
return;
}
sub test_default : Test(1) {
my $self = shift;
is $self->{class}->default, 'inactive'
=> 'default ok';
return;
}
sub test_reset : Test(1) {
my $self = shift;
$self->{instance}->number( $self->_random_level );
is $self->{instance}->reset, 'inactive'
=> 'reset ok';
return;
}
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Test::Amikeco::Value::Activity::Level::Base - Testing baseclass for Amikeco::Value::Activity::Level::*
=head1 SYNOPSIS
package Test::Amikeco::Value::Activity::Level::Foo;
use base qw(
Test::Amikeco::Value::Activity::Level::Base
);
# ...
=head1 DESCRIPTION
This module tests C<Amikeco::Value::Activity::Level::*>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
Explicit.pm
package Amikeco::Value::Activity::Level::Role::RealType::Explicit;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose;
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# consuming role(s)
# ****************************************************************
with qw(
Amikeco::Value::LevelLike::RealType
);
# ****************************************************************
# method(s) as class constants
# ****************************************************************
sub alignment {
{
inactive => 0,
normal_weekday => 2,
core_weekday => 4,
8 => 8,
holiday => 9,
100 => 100,
};
}
sub default {
'inactive';
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->_modify_type_constraints;
__PACKAGE__->meta->make_immutable;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::Activity::Level - Value Object of Activity level
=head1 SYNOPSIS
package Amikeco::Model::Activity;
use Moose;
use Moose::Util::TypeConstraints;
use Amikeco::Value::Activity::Level;
my $level_type = class_type __PACKAGE__ . '::Level';
coerce __PACKAGE__ . '::Level'
=> from 'Int'
=> via { Amikeco::Value::Activity::Level->inflate($_) };
has 'level' => (
is => 'rw',
isa => $level_type,
coerce => 1,
);
# ...
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value-Object to Moose class that consumes this role.
=head1 LEVELS
(blah blah blah)
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
Explicit.pm
package Amikeco::Value::LevelLike::RealType::Explicit;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose::Role;
use Moose::Util::TypeConstraints;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
use List::MoreUtils qw(uniq first_index);
use Memoize qw(memoize);
use Sub::Name qw(subname);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# interface(s)
# ****************************************************************
requires qw(
alignment
default
);
# ****************************************************************
# attribute(s)
# ****************************************************************
has 'name' => (
is => 'rw',
# isa => 'Str', # dynamically assigned by _modify_type_constraints()
lazy_build => 1,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear__index;
},
);
has 'number' => (
is => 'rw',
# isa => 'Int', # dynamically assigned by _modify_type_constraints()
lazy_build => 1,
trigger => sub {
$_[0]->clear_name;
$_[0]->clear__index;
},
);
has '_index' => (
traits => [qw(
Counter
)],
is => 'ro',
# writer => '_set__index',
isa => 'Int',
init_arg => undef,
# Moose::Meta::Attribute::Native::Trait::Counter implicitly brings
# 'default' option to attribute, therefore 'lazy_build' is not capable.
lazy => 1,
predicate => 'has__index',
clearer => 'clear__index',
default => \&_build__index,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear_name;
},
handles => {
promote => 'inc',
demote => 'dec',
},
);
# ****************************************************************
# builder(s)
# ****************************************************************
sub _build_number {
$_[0]->has_name ? $_[0]->to_number( $_[0]->name )
: $_[0]->has__index ? ${ $_[0]->_numbers }[ $_[0]->_index ]
: $_[0]->to_number( $_[0]->default );
}
sub _build_name {
$_[0]->has_number ? $_[0]->to_name( $_[0]->number )
: $_[0]->has__index ? ${ $_[0]->_names }[ $_[0]->_index ]
: $_[0]->default;
}
sub _build__index {
my ($self) = @_;
$_[0]->has_number ? first_index {$_ == $self->number } @{$self->_numbers}
: $_[0]->has_name ? first_index {$_ eq $self->name } @{$self->_names}
: first_index {$_ eq $self->default} @{$self->_names};
}
# ****************************************************************
# hook(s) on construction
# ****************************************************************
around BUILDARGS => sub {
my ($next, $class, @args) = @_;
# if (
# ! find_type_constraint($class . '::LevelName' ) &&
# ! find_type_constraint($class . '::LevelNumber')
# ) {
# $class->meta->make_mutable;
# $class->_modify_type_constraints;
# $class->meta->make_immutable;
# }
my $init_args = $class->$next(@args);
confess 'Initialization argument must be any one of name or number'
if exists $init_args->{name} && exists $init_args->{number};
return $init_args;
};
# ****************************************************************
# modifier(s) of type constraint(s)
# ****************************************************************
sub _modify_type_constraints {
my $class = shift;
my $is_immutable = $class->meta->is_immutable;
$class->meta->make_mutable
if $is_immutable;
$class->meta->add_attribute(
'+name' => (
isa => enum $class . '::LevelName' => @{ $class->_names },
)
);
$class->meta->add_attribute(
'+number' => (
isa => enum $class . '::LevelNumber' => @{ $class->_numbers },
)
);
$class->meta->make_immutable
if $is_immutable;
return;
}
# ****************************************************************
# limitter(s)
# ****************************************************************
around promote => sub {
my ($next, $self) = @_;
return if $self->is_maximum;
return $self->$next;
};
around demote => sub {
my ($next, $self) = @_;
return if $self->is_minimum;
return $self->$next;
};
# ****************************************************************
# estimator(s)
# ****************************************************************
sub is_maximum {
$_[0]->has_number ? $_[0]->number == $_[0]->maximum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->maximum_name
: $_[0]->_index == $#{ $_[0]->_numbers };
}
sub is_minimum {
$_[0]->has_number ? $_[0]->number == $_[0]->minimum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->minimum_name
: $_[0]->_index == 0;
}
# ****************************************************************
# convenience mutator(s)
# ****************************************************************
sub reset {
# $_[0]->has_number ? $_[0]->number($_[0]->to_number($_[0]->default))
# : $_[0]->name($_[0]->default);
$_[0]->name($_[0]->default);
}
sub maximize {
# $_[0]->has_number ? $_[0]->number($_[0]->maximum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->maximum_name)
# : $_[0]->_set__index(-1);
$_[0]->number($_[0]->maximum_number);
}
sub minimize {
# $_[0]->has_number ? $_[0]->number($_[0]->minimum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->minimum_name)
# : $_[0]->_set__index(0);
$_[0]->number($_[0]->minimum_number);
}
# ****************************************************************
# interface(s) to persistent storage
# ****************************************************************
sub inflate {
$_[0]->new(
number => $_[1],
);
}
sub deflate {
$_[0]->number;
}
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub minimum_number {
${ $_[0]->_numbers }[0];
}
sub maximum_number {
${ $_[0]->_numbers }[-1];
}
sub minimum_name {
${ $_[0]->_names }[0];
}
sub maximum_name {
${ $_[0]->_names }[-1];
}
sub _names_to_numbers {
# this role cannot validate the names-to-numbers alignment
# (keys of alignment are already unique)
return $_[0]->alignment;
}
sub _numbers_to_names {
my @numbers = values %{ $_[0]->_names_to_numbers };
# validation is not capabile in (this role's) compile-time
confess 'Numbers of level are not unique'
if @numbers != scalar uniq @numbers;
return {
reverse %{ $_[0]->_names_to_numbers }
};
}
sub _names {
# sort keys by value
my $names_to_numbers = $_[0]->_names_to_numbers;
return [
map {
$_->[0]
} sort {
$a->[1] <=> $b->[1];
} map {
[ $_, $names_to_numbers->{ $_ } ];
} keys %$names_to_numbers
];
}
sub _numbers {
return [
sort { $a <=> $b } values %{ $_[0]->_names_to_numbers }
];
}
# ****************************************************************
# utility method(s) of handmade coercion
# ****************************************************************
sub to_number {
return ${ $_[0]->_names_to_numbers }{$_[1]};
}
sub to_name {
return ${ $_[0]->_numbers_to_names }{$_[1]};
}
# ****************************************************************
# memoization
# ****************************************************************
sub _memoize {
no strict 'refs';
foreach my $method (qw(
_numbers _names
_names_to_numbers _numbers_to_names
to_number to_name
maximum_number maximum_name
minimum_number minimum_name
)) {
*{ $method } = subname __PACKAGE__ . '::' . $method => memoize($method);
}
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->_memoize;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::LevelLike - Role of level-like Value Objects for Moose
=head1 SYNOPSIS
{
package Amikeco::Value::FooLevel;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
foo => 0,
bar => 1,
baz => 4,
5 => 5,
qux => 9,
};
}
sub default {
'foo'; # cannot use 0
}
__PACKAGE__->_modify_type_constraints; # CAVEAT: REMEMBER IT!
__PACKAGE__->meta->make_immutable;
}
{
package main;
my $from_database = 0; # 0
my $level = Amikeco::Value::FooLevel->inflate($value_on_database);
$level->promote; # 0(foo) to 1(bar)
$level->demote; # 1(bar) to 0(foo)
$level->number(4); # 0(foo) to 4(baz)
$level->name('bar'); # 4(baz) to 1(bar)
my $to_database = $level->deflate; # 1
}
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value Objects to Moose class that consumes this role.
For example, C<Gender> Value Object explains that 0 is male and 1 is female.
{
package Amikeco::Value::Gender;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
male => 0,
female => 1,
};
}
sub default {
confess 'Default gender is not defined';
}
__PACKAGE__->_modify_type_constraints;
__PACKAGE__->meta->make_immutable;
}
=head1 METHODS
(blah blah blah)
=head1 SEE ALSO
=over 4
=item Memoizing role methods
L<http://thread.gmane.org/gmane.comp.lang.perl.moose/793/focus=797>
=item Value Objects
Martin Fowler,
C<Patterns of Enterprise Application Architecture>,
Toronto: Addison-Wesley Professional,
2002,
560p.,
ISBN 0321127420 / 978-0321127426
=item dualvar
This module does not use L<Scalar::Util::dualvar()|Scalar::Util>
for number/name alignment
because non-acrobatic values favorable for return value.
=back
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
Explicit.pm
package Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit;
# ****************************************************************
# pragma(s)
# ****************************************************************
use strict;
use warnings;
# ****************************************************************
# superclass(es)
# ****************************************************************
use base qw(
Test::Amikeco::Value::Activity::Level::Base
);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean;
# ****************************************************************
# internal dependency(-ies)
# ****************************************************************
use Amikeco::Value::Activity::Level::Role::RealType::Explicit;
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub _target_class {
'Amikeco::Value::Activity::Level::Role::RealType::Explicit';
}
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit - Testing baseclass for Amikeco::Value::Activity::Level::Role::RealType::Explicit
=head1 SYNOPSIS
use Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit;
Test::Amikeco::Value::Activity::Level::Role::RealType::Explicit->runtests;
=head1 DESCRIPTION
This module tests L<Amikeco::Value::Activity::Level::Role::RealType::Explicit>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
Makefile.PL
#!/usr/bin/perl
use strict;
use warnings;
use inc::Module::Install;
my $application_root_module
= 'lib/Amikeco/Value/Activity/Level/Role/RealType.pm';
# ================================================================
# meta information
# ================================================================
# abstract, author, license, name, perl_version, version
all_from $application_root_module;
name 'Amikeco-Value-Activity-Level';
perl_version 5.008_001;
version "0.00";
# supplement
author 'MORIYA Masaki (a.k.a. "Gardejo") <moriya@cpan.org>';
resources (
repository
=> 'git://gist.github.com/230058.git',
bugtracker
=> undef,
homepage
=> 'http://gist.github.com/230058',
);
# no_index directory => 'examples';
# no_index directory => 'extlib';
# ================================================================
# build dependencies
# ================================================================
build_requires 'Module::Install' => '0.80'; # YAML::Tiny problem
build_requires 'Module::Load' => '0'; # > perl 5.009_004
# ================================================================
# general dependencies
# ================================================================
requires 'List::MoreUtils' => '0';
requires 'Memoize' => '0';
requires 'Moose' => '0.41';
requires 'Sub::Name' => '0';
requires 'namespace::clean' => '0.08'; # cf. MX-Types-DateTime
# ================================================================
# dependencies for tests
# ================================================================
test_requires 'Test::Class' => '0'; # without intention
test_requires 'Test::Exception' => '0.27'; # cf. MX-Types-DateTime
test_requires 'Test::More' => '0'; # without intention
test_requires 'Test::Warn' => '0'; # without intention
# ================================================================
# tests
# ================================================================
use_test_base;
tests 't/*.t';
# author_tests 'xt';
# ================================================================
# installation
# ================================================================
auto_include;
auto_install;
# ================================================================
# META.yml writter
# ================================================================
WriteAll;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Makefile.PL - Makefile builder for gist: 230058
=head1 SYNOPSIS
$ cpan -t .
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
MANIFEST.SKIP
# This MANIFEST.SKIP file was stolen from MooseX-Types-DateTime
# Avoid version control files.
\bRCS\b
\bCVS\b
\bSCCS\b
,v$
\B\.svn\b
\B\.git\b
\b_darcs\b
# Avoid Makemaker generated and utility files.
\bMANIFEST\.bak
\bMakefile$
\bblib/
\bMakeMaker-\d
\bpm_to_blib\.ts$
\bpm_to_blib$
\bblibdirs\.ts$ # 6.18 through 6.25 generated this
# Avoid Module::Build generated and utility files.
\bBuild$
\b_build/
# Avoid temp and backup files.
~$
\.old$
\#$
\b\.#
\.bak$
# Avoid Devel::Cover files.
\bcover_db\b
### DEFAULT MANIFEST.SKIP ENDS HERE ####
\.DS_Store$
\.sw.$
(\w+-)*(\w+)-\d\.\d+(?:\.tar\.gz)?$
\.t\.log$
Raw
PseudoType.pm
package Amikeco::Value::Activity::Level::Role::PseudoType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose;
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# consuming role(s)
# ****************************************************************
with qw(
Amikeco::Value::LevelLike::PseudoType
);
# ****************************************************************
# method(s) as class constants
# ****************************************************************
sub alignment {
{
inactive => 0,
normal_weekday => 2,
core_weekday => 4,
8 => 8,
holiday => 9,
100 => 100,
};
}
sub default {
'inactive';
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->meta->make_immutable;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::Activity::Level - Value Object of Activity level
=head1 SYNOPSIS
package Amikeco::Model::Activity;
use Moose;
use Moose::Util::TypeConstraints;
use Amikeco::Value::Activity::Level;
my $level_type = class_type __PACKAGE__ . '::Level';
coerce __PACKAGE__ . '::Level'
=> from 'Int'
=> via { Amikeco::Value::Activity::Level->inflate($_) };
has 'level' => (
is => 'rw',
isa => $level_type,
coerce => 1,
);
# ...
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value-Object to Moose class that consumes this role.
=head1 LEVELS
(blah blah blah)
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
PseudoType.pm
package Amikeco::Value::LevelLike::PseudoType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose::Role;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
use Carp qw(croak);
use List::MoreUtils qw(uniq first_index);
use Memoize qw(memoize);
use Sub::Name qw(subname);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# interface(s)
# ****************************************************************
requires qw(
alignment
default
);
# ****************************************************************
# attribute(s)
# ****************************************************************
has 'name' => (
is => 'rw',
isa => 'Str',
lazy_build => 1,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear__index;
},
);
has 'number' => (
is => 'rw',
isa => 'Int',
lazy_build => 1,
trigger => sub {
$_[0]->clear_name;
$_[0]->clear__index;
},
);
has '_index' => (
traits => [qw(
Counter
)],
is => 'ro',
# writer => '_set__index',
isa => 'Int',
init_arg => undef,
# Moose::Meta::Attribute::Native::Trait::Counter implicitly brings
# 'default' option to attribute, therefore 'lazy_build' is not capable.
lazy => 1,
predicate => 'has__index',
clearer => 'clear__index',
default => \&_build__index,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear_name;
},
handles => {
promote => 'inc',
demote => 'dec',
},
);
# ****************************************************************
# builder(s)
# ****************************************************************
sub _build_number {
$_[0]->has_name ? $_[0]->to_number( $_[0]->name )
: $_[0]->has__index ? ${ $_[0]->_numbers }[ $_[0]->_index ]
: $_[0]->to_number( $_[0]->default );
}
sub _build_name {
$_[0]->has_number ? $_[0]->to_name( $_[0]->number )
: $_[0]->has__index ? ${ $_[0]->_names }[ $_[0]->_index ]
: $_[0]->default;
}
sub _build__index {
my ($self) = @_;
$_[0]->has_number ? first_index {$_ == $self->number } @{$self->_numbers}
: $_[0]->has_name ? first_index {$_ eq $self->name } @{$self->_names}
: first_index {$_ eq $self->default} @{$self->_names};
}
# ****************************************************************
# pseudo type constraint(s)
# ****************************************************************
around BUILDARGS => sub {
my ($next, $class, @args) = @_;
my $init_args = $class->$next(@args);
$class->_validate_name($init_args->{name})
if exists $init_args->{name};
$class->_validate_number($init_args->{number})
if exists $init_args->{number};
confess 'Initialization argument must be any one of name or number'
if exists $init_args->{name} && exists $init_args->{number};
return $init_args;
};
around name => sub {
my ($next, $self, @args) = @_;
$self->_validate_name(@args)
if @args;
return $self->$next(@args);
};
around number => sub {
my ($next, $self, @args) = @_;
$self->_validate_number(@args)
if @args;
return $self->$next(@args);
};
sub _validate_name {
local $Carp::CarpLevel = 1;
croak sprintf (
"Attribute (name) does not pass the pseudo type constraint because: "
. "Validation failed for '%s' failed with value %s",
ref($_[0]) . '::LevelName',
defined $_[1] ? $_[1] : 'undef',
) if ! defined $_[1]
|| ! exists ${ $_[0]->_names_to_numbers }{ $_[1] };
}
sub _validate_number {
local $Carp::CarpLevel = 1;
croak sprintf (
"Attribute (number) does not pass the pseudo type constraint because: "
. "Validation failed for '%s' failed with value %s",
ref($_[0]) . '::LevelName',
defined $_[1] ? $_[1] : 'undef',
) if ! defined $_[1]
|| ! exists ${ $_[0]->_numbers_to_names }{ $_[1] };
}
# ****************************************************************
# limitter(s)
# ****************************************************************
around promote => sub {
my ($next, $self) = @_;
return if $self->is_maximum;
return $self->$next;
};
around demote => sub {
my ($next, $self) = @_;
return if $self->is_minimum;
return $self->$next;
};
# ****************************************************************
# estimator(s)
# ****************************************************************
sub is_maximum {
$_[0]->has_number ? $_[0]->number == $_[0]->maximum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->maximum_name
: $_[0]->_index == $#{ $_[0]->_numbers };
}
sub is_minimum {
$_[0]->has_number ? $_[0]->number == $_[0]->minimum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->minimum_name
: $_[0]->_index == 0;
}
# ****************************************************************
# convenience mutator(s)
# ****************************************************************
sub reset {
# $_[0]->has_number ? $_[0]->number($_[0]->to_number($_[0]->default))
# : $_[0]->name($_[0]->default);
$_[0]->name($_[0]->default);
}
sub maximize {
# $_[0]->has_number ? $_[0]->number($_[0]->maximum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->maximum_name)
# : $_[0]->_set__index(-1);
$_[0]->number($_[0]->maximum_number);
}
sub minimize {
# $_[0]->has_number ? $_[0]->number($_[0]->minimum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->minimum_name)
# : $_[0]->_set__index(0);
$_[0]->number($_[0]->minimum_number);
}
# ****************************************************************
# interface(s) to persistent storage
# ****************************************************************
sub inflate {
$_[0]->new(
number => $_[1],
);
}
sub deflate {
$_[0]->number;
}
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub minimum_number {
${ $_[0]->_numbers }[0];
}
sub maximum_number {
${ $_[0]->_numbers }[-1];
}
sub minimum_name {
${ $_[0]->_names }[0];
}
sub maximum_name {
${ $_[0]->_names }[-1];
}
sub _names_to_numbers {
# this role cannot validate the names-to-numbers alignment
# (keys of alignment are already unique)
return $_[0]->alignment;
}
sub _numbers_to_names {
my @numbers = values %{ $_[0]->_names_to_numbers };
# validation is not capabile in (this role's) compile-time
confess 'Numbers of level are not unique'
if @numbers != scalar uniq @numbers;
return {
reverse %{ $_[0]->_names_to_numbers }
};
}
sub _names {
# sort keys by value
my $names_to_numbers = $_[0]->_names_to_numbers;
return [
map {
$_->[0]
} sort {
$a->[1] <=> $b->[1];
} map {
[ $_, $names_to_numbers->{ $_ } ];
} keys %$names_to_numbers
];
}
sub _numbers {
return [
sort { $a <=> $b } values %{ $_[0]->_names_to_numbers }
];
}
# ****************************************************************
# utility method(s) of handmade coercion
# ****************************************************************
sub to_number {
return ${ $_[0]->_names_to_numbers }{$_[1]};
}
sub to_name {
return ${ $_[0]->_numbers_to_names }{$_[1]};
}
# ****************************************************************
# memoization
# ****************************************************************
sub _memoize {
no strict 'refs';
foreach my $method (qw(
_numbers _names
_names_to_numbers _numbers_to_names
to_number to_name
maximum_number maximum_name
minimum_number minimum_name
)) {
*{ $method } = subname __PACKAGE__ . '::' . $method => memoize($method);
}
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->_memoize;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::LevelLike - Role of level-like Value Objects for Moose
=head1 SYNOPSIS
{
package Amikeco::Value::FooLevel;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
foo => 0,
bar => 1,
baz => 4,
5 => 5,
qux => 9,
};
}
sub default {
'foo'; # cannot use 0
}
__PACKAGE__->meta->make_immutable;
}
{
package main;
my $from_database = 0; # 0
my $level = Amikeco::Value::FooLevel->inflate($value_on_database);
$level->promote; # 0(foo) to 1(bar)
$level->demote; # 1(bar) to 0(foo)
$level->number(4); # 0(foo) to 4(baz)
$level->name('bar'); # 4(baz) to 1(bar)
my $to_database = $level->deflate; # 1
}
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value Objects to Moose class that consumes this role.
For example, C<Gender> Value Object explains that 0 is male and 1 is female.
{
package Amikeco::Value::Gender;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
male => 0,
female => 1,
};
}
sub default {
confess 'Default gender is not defined';
}
__PACKAGE__->meta->make_immutable;
}
=head1 METHODS
(blah blah blah)
=head1 SEE ALSO
=over 4
=item Memoizing role methods
L<http://thread.gmane.org/gmane.comp.lang.perl.moose/793/focus=797>
=item Value Objects
Martin Fowler,
C<Patterns of Enterprise Application Architecture>,
Toronto: Addison-Wesley Professional,
2002,
560p.,
ISBN 0321127420 / 978-0321127426
=item dualvar
This module does not use L<Scalar::Util::dualvar()|Scalar::Util>
for number/name alignment
because non-acrobatic values favorable for return value.
=back
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
PseudoType.pm
package Test::Amikeco::Value::Activity::Level::Role::PseudoType;
# ****************************************************************
# pragma(s)
# ****************************************************************
use strict;
use warnings;
# ****************************************************************
# superclass(es)
# ****************************************************************
use base qw(
Test::Amikeco::Value::Activity::Level::Base
);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean;
# ****************************************************************
# internal dependency(-ies)
# ****************************************************************
use Amikeco::Value::Activity::Level::Role::PseudoType;
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub _target_class {
'Amikeco::Value::Activity::Level::Role::PseudoType';
}
sub _message_pattern {
my ($self, $key) = @_;
my %message_pattern = (
$self->SUPER::_message_pattern,
non_enumrated_name
=> qr{^Attribute \(name\) does not pass the pseudo type constraint},
non_enumrated_number
=> qr{^Attribute \(number\) does not pass the pseudo type constraint},
);
return $key ? $message_pattern{$key} : %message_pattern;
}
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Test::Amikeco::Value::Activity::Level::Role::PseudoType - Testing baseclass for Amikeco::Value::Activity::Level::Role::PseudoType
=head1 SYNOPSIS
use Test::Amikeco::Value::Activity::Level::Role::PseudoType;
Test::Amikeco::Value::Activity::Level::Role::PseudoType->runtests;
=head1 DESCRIPTION
This module tests L<Amikeco::Value::Activity::Level::Role::PseudoType>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Amikeco::Value::Activity::Level::Role::RealType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose;
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# consuming role(s)
# ****************************************************************
with qw(
Amikeco::Value::LevelLike::RealType
);
# ****************************************************************
# method(s) as class constants
# ****************************************************************
sub alignment {
{
inactive => 0,
normal_weekday => 2,
core_weekday => 4,
8 => 8,
holiday => 9,
100 => 100,
};
}
sub default {
'inactive';
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->meta->make_immutable;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::Activity::Level - Value Object of Activity level
=head1 SYNOPSIS
package Amikeco::Model::Activity;
use Moose;
use Moose::Util::TypeConstraints;
use Amikeco::Value::Activity::Level;
my $level_type = class_type __PACKAGE__ . '::Level';
coerce __PACKAGE__ . '::Level'
=> from 'Int'
=> via { Amikeco::Value::Activity::Level->inflate($_) };
has 'level' => (
is => 'rw',
isa => $level_type,
coerce => 1,
);
# ...
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value-Object to Moose class that consumes this role.
=head1 LEVELS
(blah blah blah)
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Amikeco::Value::Activity::Level::Subclass::RealType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose;
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# consuming role(s)
# ****************************************************************
extends qw(
Amikeco::Value::LevelBase::RealType
);
# ****************************************************************
# method(s) as class constants
# ****************************************************************
sub alignment {
{
inactive => 0,
normal_weekday => 2,
core_weekday => 4,
8 => 8,
holiday => 9,
100 => 100,
};
}
sub default {
'inactive';
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->meta->make_immutable;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::Activity::Level - Value Object of Activity level
=head1 SYNOPSIS
package Amikeco::Model::Activity;
use Moose;
use Moose::Util::TypeConstraints;
use Amikeco::Value::Activity::Level;
my $level_type = class_type __PACKAGE__ . '::Level';
coerce __PACKAGE__ . '::Level'
=> from 'Int'
=> via { Amikeco::Value::Activity::Level->inflate($_) };
has 'level' => (
is => 'rw',
isa => $level_type,
coerce => 1,
);
# ...
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value-Object to Moose class that consumes this role.
=head1 LEVELS
(blah blah blah)
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Amikeco::Value::LevelBase::RealType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose;
use Moose::Util::TypeConstraints;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
use List::MoreUtils qw(uniq first_index);
use Memoize qw(memoize);
use Sub::Name qw(subname);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# attribute(s)
# ****************************************************************
has 'name' => (
is => 'rw',
# isa => 'Str', # 'isa' is dynamically assigned by BUILDARGS()
lazy_build => 1,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear__index;
},
);
has 'number' => (
is => 'rw',
# isa => 'Int', # 'isa' is dynamically assigned by BUILDARGS()
lazy_build => 1,
trigger => sub {
$_[0]->clear_name;
$_[0]->clear__index;
},
);
has '_index' => (
traits => [qw(
Counter
)],
is => 'rw',
# writer => '_set__index',
isa => 'Int',
init_arg => undef,
# Moose::Meta::Attribute::Native::Trait::Counter implicitly brings
# 'default' option to attribute, therefore 'lazy_build' is not capable.
lazy => 1,
predicate => 'has__index',
clearer => 'clear__index',
default => \&_build__index,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear_name;
},
handles => {
promote => 'inc',
demote => 'dec',
},
);
# ****************************************************************
# builder(s)
# ****************************************************************
sub _build_number {
$_[0]->has_name ? $_[0]->to_number( $_[0]->name )
: $_[0]->has__index ? ${ $_[0]->_numbers }[ $_[0]->_index ]
: $_[0]->to_number( $_[0]->default );
}
sub _build_name {
$_[0]->has_number ? $_[0]->to_name( $_[0]->number )
: $_[0]->has__index ? ${ $_[0]->_names }[ $_[0]->_index ]
: $_[0]->default;
}
sub _build__index {
my ($self) = @_;
$_[0]->has_number ? first_index {$_ == $self->number } @{$self->_numbers}
: $_[0]->has_name ? first_index {$_ eq $self->name } @{$self->_names}
: first_index {$_ eq $self->default} @{$self->_names};
}
# ****************************************************************
# hook(s) on construction
# ****************************************************************
around BUILDARGS => sub {
my ($next, $class, @args) = @_;
if (
! find_type_constraint($class . '::LevelName' ) &&
! find_type_constraint($class . '::LevelNumber')
) {
$class->meta->make_mutable;
$class->_modify_type_constraints;
$class->meta->make_immutable;
}
my $init_args = $class->$next(@args);
confess 'Initialization argument must be any one of name or number'
if exists $init_args->{name} && exists $init_args->{number};
return $init_args;
};
# ****************************************************************
# modifier(s) of type constraint(s)
# ****************************************************************
sub _modify_type_constraints {
my $class = shift;
$class->meta->add_attribute(
'+name' => (
isa => enum $class . '::LevelName' => @{ $class->_names },
)
);
$class->meta->add_attribute(
'+number' => (
isa => enum $class . '::LevelNumber' => @{ $class->_numbers },
)
);
return;
}
# ****************************************************************
# limitter(s)
# ****************************************************************
around promote => sub {
my ($next, $self) = @_;
return if $self->is_maximum;
return $self->$next;
};
around demote => sub {
my ($next, $self) = @_;
return if $self->is_minimum;
return $self->$next;
};
# ****************************************************************
# estimator(s)
# ****************************************************************
sub is_maximum {
$_[0]->has_number ? $_[0]->number == $_[0]->maximum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->maximum_name
: $_[0]->_index == $#{ $_[0]->_numbers };
}
sub is_minimum {
$_[0]->has_number ? $_[0]->number == $_[0]->minimum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->minimum_name
: $_[0]->_index == 0;
}
# ****************************************************************
# convenience mutator(s)
# ****************************************************************
sub reset {
# $_[0]->has_number ? $_[0]->number($_[0]->to_number($_[0]->default))
# : $_[0]->name($_[0]->default);
$_[0]->name($_[0]->default);
}
sub maximize {
# $_[0]->has_number ? $_[0]->number($_[0]->maximum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->maximum_name)
# : $_[0]->_set__index(-1);
$_[0]->number($_[0]->maximum_number);
}
sub minimize {
# $_[0]->has_number ? $_[0]->number($_[0]->minimum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->minimum_name)
# : $_[0]->_set__index(0);
$_[0]->number($_[0]->minimum_number);
}
# ****************************************************************
# interface(s) to persistent storage
# ****************************************************************
sub inflate {
$_[0]->new(
number => $_[1],
);
}
sub deflate {
$_[0]->number;
}
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub minimum_number {
${ $_[0]->_numbers }[0];
}
sub maximum_number {
${ $_[0]->_numbers }[-1];
}
sub minimum_name {
${ $_[0]->_names }[0];
}
sub maximum_name {
${ $_[0]->_names }[-1];
}
sub _names_to_numbers {
# this role cannot validate the names-to-numbers alignment
# (keys of alignment are already unique)
return $_[0]->alignment;
}
sub _numbers_to_names {
my @numbers = values %{ $_[0]->_names_to_numbers };
# validation is not capabile in (this role's) compile-time
confess 'Numbers of level are not unique'
if @numbers != scalar uniq @numbers;
return {
reverse %{ $_[0]->_names_to_numbers }
};
}
sub _names {
# sort keys by value
my $names_to_numbers = $_[0]->_names_to_numbers;
return [
map {
$_->[0]
} sort {
$a->[1] <=> $b->[1];
} map {
[ $_, $names_to_numbers->{ $_ } ];
} keys %$names_to_numbers
];
}
sub _numbers {
return [
sort { $a <=> $b } values %{ $_[0]->_names_to_numbers }
];
}
# ****************************************************************
# utility method(s) of handmade coercion
# ****************************************************************
sub to_number {
return ${ $_[0]->_names_to_numbers }{$_[1]};
}
sub to_name {
return ${ $_[0]->_numbers_to_names }{$_[1]};
}
# ****************************************************************
# memoization
# ****************************************************************
sub _memoize {
no strict 'refs';
foreach my $method (qw(
_numbers _names
_names_to_numbers _numbers_to_names
to_number to_name
maximum_number maximum_name
minimum_number minimum_name
)) {
*{ $method } = subname __PACKAGE__ . '::' . $method => memoize($method);
}
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->meta->make_immutable;
__PACKAGE__->_memoize;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::LevelLike - Role of level-like Value Objects for Moose
=head1 SYNOPSIS
{
package Amikeco::Value::FooLevel;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
foo => 0,
bar => 1,
baz => 4,
5 => 5,
qux => 9,
};
}
sub default {
'foo'; # cannot use 0
}
__PACKAGE__->meta->make_immutable;
}
{
package main;
my $from_database = 0; # 0
my $level = Amikeco::Value::FooLevel->inflate($value_on_database);
$level->promote; # 0(foo) to 1(bar)
$level->demote; # 1(bar) to 0(foo)
$level->number(4); # 0(foo) to 4(baz)
$level->name('bar'); # 4(baz) to 1(bar)
my $to_database = $level->deflate; # 1
}
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value Objects to Moose class that consumes this role.
For example, C<Gender> Value Object explains that 0 is male and 1 is female.
{
package Amikeco::Value::Gender;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
male => 0,
female => 1,
};
}
sub default {
confess 'Default gender is not defined';
}
__PACKAGE__->meta->make_immutable;
}
=head1 METHODS
(blah blah blah)
=head1 SEE ALSO
=over 4
=item Memoizing role methods
L<http://thread.gmane.org/gmane.comp.lang.perl.moose/793/focus=797>
=item Value Objects
Martin Fowler,
C<Patterns of Enterprise Application Architecture>,
Toronto: Addison-Wesley Professional,
2002,
560p.,
ISBN 0321127420 / 978-0321127426
=item dualvar
This module does not use L<Scalar::Util::dualvar()|Scalar::Util>
for number/name alignment
because non-acrobatic values favorable for return value.
=back
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Amikeco::Value::LevelLike::RealType;
# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************
use Moose::Role;
use Moose::Util::TypeConstraints;
# ****************************************************************
# general dependency(-ies)
# ****************************************************************
use List::MoreUtils qw(uniq first_index);
use Memoize qw(memoize);
use Sub::Name qw(subname);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean -except => [qw(meta)];
# ****************************************************************
# interface(s)
# ****************************************************************
requires qw(
alignment
default
);
# ****************************************************************
# attribute(s)
# ****************************************************************
has 'name' => (
is => 'rw',
# isa => 'Str', # 'isa' is dynamically assigned by BUILDARGS()
lazy_build => 1,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear__index;
},
);
has 'number' => (
is => 'rw',
# isa => 'Int', # 'isa' is dynamically assigned by BUILDARGS()
lazy_build => 1,
trigger => sub {
$_[0]->clear_name;
$_[0]->clear__index;
},
);
has '_index' => (
traits => [qw(
Counter
)],
is => 'ro',
# writer => '_set__index',
isa => 'Int',
init_arg => undef,
# Moose::Meta::Attribute::Native::Trait::Counter implicitly brings
# 'default' option to attribute, therefore 'lazy_build' is not capable.
lazy => 1,
predicate => 'has__index',
clearer => 'clear__index',
default => \&_build__index,
trigger => sub {
$_[0]->clear_number;
$_[0]->clear_name;
},
handles => {
promote => 'inc',
demote => 'dec',
},
);
# ****************************************************************
# builder(s)
# ****************************************************************
sub _build_number {
$_[0]->has_name ? $_[0]->to_number( $_[0]->name )
: $_[0]->has__index ? ${ $_[0]->_numbers }[ $_[0]->_index ]
: $_[0]->to_number( $_[0]->default );
}
sub _build_name {
$_[0]->has_number ? $_[0]->to_name( $_[0]->number )
: $_[0]->has__index ? ${ $_[0]->_names }[ $_[0]->_index ]
: $_[0]->default;
}
sub _build__index {
my ($self) = @_;
$_[0]->has_number ? first_index {$_ == $self->number } @{$self->_numbers}
: $_[0]->has_name ? first_index {$_ eq $self->name } @{$self->_names}
: first_index {$_ eq $self->default} @{$self->_names};
}
# ****************************************************************
# hook(s) on construction
# ****************************************************************
around BUILDARGS => sub {
my ($next, $class, @args) = @_;
if (
! find_type_constraint($class . '::LevelName' ) &&
! find_type_constraint($class . '::LevelNumber')
) {
$class->meta->make_mutable;
$class->_modify_type_constraints;
$class->meta->make_immutable;
}
my $init_args = $class->$next(@args);
confess 'Initialization argument must be any one of name or number'
if exists $init_args->{name} && exists $init_args->{number};
return $init_args;
};
# ****************************************************************
# modifier(s) of type constraint(s)
# ****************************************************************
sub _modify_type_constraints {
my $class = shift;
$class->meta->add_attribute(
'+name' => (
isa => enum $class . '::LevelName' => @{ $class->_names },
)
);
$class->meta->add_attribute(
'+number' => (
isa => enum $class . '::LevelNumber' => @{ $class->_numbers },
)
);
return;
}
# ****************************************************************
# limitter(s)
# ****************************************************************
around promote => sub {
my ($next, $self) = @_;
return if $self->is_maximum;
return $self->$next;
};
around demote => sub {
my ($next, $self) = @_;
return if $self->is_minimum;
return $self->$next;
};
# ****************************************************************
# estimator(s)
# ****************************************************************
sub is_maximum {
$_[0]->has_number ? $_[0]->number == $_[0]->maximum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->maximum_name
: $_[0]->_index == $#{ $_[0]->_numbers };
}
sub is_minimum {
$_[0]->has_number ? $_[0]->number == $_[0]->minimum_number
: $_[0]->has_name ? $_[0]->name eq $_[0]->minimum_name
: $_[0]->_index == 0;
}
# ****************************************************************
# convenience mutator(s)
# ****************************************************************
sub reset {
# $_[0]->has_number ? $_[0]->number($_[0]->to_number($_[0]->default))
# : $_[0]->name($_[0]->default);
$_[0]->name($_[0]->default);
}
sub maximize {
# $_[0]->has_number ? $_[0]->number($_[0]->maximum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->maximum_name)
# : $_[0]->_set__index(-1);
$_[0]->number($_[0]->maximum_number);
}
sub minimize {
# $_[0]->has_number ? $_[0]->number($_[0]->minimum_number)
# : $_[0]->has_name ? $_[0]->name($_[0]->minimum_name)
# : $_[0]->_set__index(0);
$_[0]->number($_[0]->minimum_number);
}
# ****************************************************************
# interface(s) to persistent storage
# ****************************************************************
sub inflate {
$_[0]->new(
number => $_[1],
);
}
sub deflate {
$_[0]->number;
}
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub minimum_number {
${ $_[0]->_numbers }[0];
}
sub maximum_number {
${ $_[0]->_numbers }[-1];
}
sub minimum_name {
${ $_[0]->_names }[0];
}
sub maximum_name {
${ $_[0]->_names }[-1];
}
sub _names_to_numbers {
# this role cannot validate the names-to-numbers alignment
# (keys of alignment are already unique)
return $_[0]->alignment;
}
sub _numbers_to_names {
my @numbers = values %{ $_[0]->_names_to_numbers };
# validation is not capabile in (this role's) compile-time
confess 'Numbers of level are not unique'
if @numbers != scalar uniq @numbers;
return {
reverse %{ $_[0]->_names_to_numbers }
};
}
sub _names {
# sort keys by value
my $names_to_numbers = $_[0]->_names_to_numbers;
return [
map {
$_->[0]
} sort {
$a->[1] <=> $b->[1];
} map {
[ $_, $names_to_numbers->{ $_ } ];
} keys %$names_to_numbers
];
}
sub _numbers {
return [
sort { $a <=> $b } values %{ $_[0]->_names_to_numbers }
];
}
# ****************************************************************
# utility method(s) of handmade coercion
# ****************************************************************
sub to_number {
return ${ $_[0]->_names_to_numbers }{$_[1]};
}
sub to_name {
return ${ $_[0]->_numbers_to_names }{$_[1]};
}
# ****************************************************************
# memoization
# ****************************************************************
sub _memoize {
no strict 'refs';
foreach my $method (qw(
_numbers _names
_names_to_numbers _numbers_to_names
to_number to_name
maximum_number maximum_name
minimum_number minimum_name
)) {
*{ $method } = subname __PACKAGE__ . '::' . $method => memoize($method);
}
}
# ****************************************************************
# compile-time processes
# ****************************************************************
__PACKAGE__->_memoize;
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Amikeco::Value::LevelLike - Role of level-like Value Objects for Moose
=head1 SYNOPSIS
{
package Amikeco::Value::FooLevel;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
foo => 0,
bar => 1,
baz => 4,
5 => 5,
qux => 9,
};
}
sub default {
'foo'; # cannot use 0
}
__PACKAGE__->meta->make_immutable;
}
{
package main;
my $from_database = 0; # 0
my $level = Amikeco::Value::FooLevel->inflate($value_on_database);
$level->promote; # 0(foo) to 1(bar)
$level->demote; # 1(bar) to 0(foo)
$level->number(4); # 0(foo) to 4(baz)
$level->name('bar'); # 4(baz) to 1(bar)
my $to_database = $level->deflate; # 1
}
=head1 DESCRIPTION
This Moose::Role module provides basic infrastructure of level-based
Value Objects to Moose class that consumes this role.
For example, C<Gender> Value Object explains that 0 is male and 1 is female.
{
package Amikeco::Value::Gender;
use Moose;
with qw(Amikeco::Value::LevelLike);
sub alignment {
{
male => 0,
female => 1,
};
}
sub default {
confess 'Default gender is not defined';
}
__PACKAGE__->meta->make_immutable;
}
=head1 METHODS
(blah blah blah)
=head1 SEE ALSO
=over 4
=item Memoizing role methods
L<http://thread.gmane.org/gmane.comp.lang.perl.moose/793/focus=797>
=item Value Objects
Martin Fowler,
C<Patterns of Enterprise Application Architecture>,
Toronto: Addison-Wesley Professional,
2002,
560p.,
ISBN 0321127420 / 978-0321127426
=item dualvar
This module does not use L<Scalar::Util::dualvar()|Scalar::Util>
for number/name alignment
because non-acrobatic values favorable for return value.
=back
=head1 INCOMPATIBILITIES
None reported.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
=head2 Making suggestions and reporting bugs
See L<the same section on document of Amikeco|Amikeco/Making_suggestions_and_reporting_bugs>
=head1 SUPPORT
See L<the same section on document of Amikeco|Amikeco/SUPPORT>
=head1 VERSION CONTROL
This module is maintained using git.
You can get the latest version from
L<git://github.com/gardejo/p5-amikeco.git>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Test::Amikeco::Value::Activity::Level::Role::RealType;
# ****************************************************************
# pragma(s)
# ****************************************************************
use strict;
use warnings;
# ****************************************************************
# superclass(es)
# ****************************************************************
use base qw(
Test::Amikeco::Value::Activity::Level::Base
);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean;
# ****************************************************************
# internal dependency(-ies)
# ****************************************************************
use Amikeco::Value::Activity::Level::Role::RealType;
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub _target_class {
'Amikeco::Value::Activity::Level::Role::RealType';
}
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Test::Amikeco::Value::Activity::Level::Role::RealType - Testing baseclass for Amikeco::Value::Activity::Level::Role::RealType
=head1 SYNOPSIS
use Test::Amikeco::Value::Activity::Level::Role::RealType;
Test::Amikeco::Value::Activity::Level::Role::RealType->runtests;
=head1 DESCRIPTION
This module tests L<Amikeco::Value::Activity::Level::Role::RealType>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Raw
RealType.pm
package Test::Amikeco::Value::Activity::Level::Subclass::RealType;
# ****************************************************************
# pragma(s)
# ****************************************************************
use strict;
use warnings;
# ****************************************************************
# superclass(es)
# ****************************************************************
use base qw(
Test::Amikeco::Value::Activity::Level::Base
);
# ****************************************************************
# namespace clearer
# ****************************************************************
use namespace::clean;
# ****************************************************************
# internal dependency(-ies)
# ****************************************************************
use Amikeco::Value::Activity::Level::Subclass::RealType;
# ****************************************************************
# method(s) as class constant(s)
# ****************************************************************
sub _target_class {
'Amikeco::Value::Activity::Level::Subclass::RealType';
}
# ****************************************************************
# return true
# ****************************************************************
1;
__END__
# ****************************************************************
# POD
# ****************************************************************
=pod
=head1 NAME
Test::Amikeco::Value::Activity::Level::Subclass::RealType - Testing baseclass for Amikeco::Value::Activity::Level::Subclass::RealType
=head1 SYNOPSIS
use Test::Amikeco::Value::Activity::Level::Subclass::RealType;
Test::Amikeco::Value::Activity::Level::Subclass::RealType->runtests;
=head1 DESCRIPTION
This module tests L<Amikeco::Value::Activity::Level::Subclass::RealType>.
=head1 AUTHOR
=over 4
=item MORIYA Masaki (a.k.a. "Gardejo")
C<< <moriya@cpan.org> >>,
L<http://ttt.ermitejo.com/>
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by MORIYA Masaki (a.k.a. "Gardejo"),
L<http://ttt.ermitejo.com>.
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl> and L<perlartistic>.
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment