#! /usr/bin/perl
use warnings;
use strict;

use Time::Piece;

{   package My;
    use Moo;
    use Time::Piece;

    sub is_date {
        my ($date) = @_;
        die "Wrong type" unless shift->isa('Time::Piece');
    }
    use namespace::clean;

    has time_piece  => (is => 'rw', isa => \&is_date);
    has string_date => (
        is => 'rw',
        coerce => sub { my $tp = shift;
                        $tp = 'Time::Piece'->strptime($tp, '%Y%m%d')
                            unless $tp->isa('Time::Piece');
                        return $tp
                    },
        isa => \&is_date);
}

my $now = localtime;
my $o = 'My'->new( time_piece  => $now,
                   string_date => '20170911' );

eval { $o->string_date($now) }      or warn "1: $@"; # works
eval { $o->string_date('a') }       or warn "2: $@"; # coercion for "s
+tring_date" failed: Error parsing time
eval { $o->time_piece('20170911') } or warn "3: $@"; # isa check for "
+time_piece" failed: Wrong type
[download]

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
[download]

Because of the dynamic nature of perl, it isn't possible to eliminate isa checks in a general way. It is certainly possible to do in your own code though. For example:

  package MyApp::SomeObject;
  use constant DEBUG => $ENV{MYAPP_DEBUG};
  use Moo;
  has foo => (
    is => 'ro',
    ( DEBUG ? (
      isa => sub {
        my $value = shift;
        if ($value !~ /^[0-9]+$/) {
          die "Not an integer: $value";
        }
      }
    ) : () ),
  );
[download]

Note that isa and coerce work slightly differently in Moose vs Moo. In Moose, first it performs the isa check. If that fails, it tries to do a coercion. The result of the coercion is then validated with the isa check. These checks are tied to Moose's type system.

Moo doesn't have a type system, so its isa and coerce are both just coderefs. The coerce sub is always run (if it exists), then its result is checked with the isa sub (if it exists). The isa sub should throw an exception on invalid values. Its return value is ignored. The coerce sub should return the coerced value. It would be possible to do all of this logic in a coerce sub, but it is convenient to be able to specify them separately.

Ok, right now I decided to use Moo, so I will write below only about Moo.

Yes, I know about it's dynamic nature and so on (about typing system). So let me express how do I feel about isa and coerce.

Coercion is something about type-casting in languages with static typing, while isa-checking is about type-checking. Since Moo doesn't have native (relatively to the framework itself) type system, we provide our own type-checking system (based on subroutines). If I'd use Moose, I could use its own type system.

---

The isa sub should throw an exception on invalid values

---

And what is about exceptions? Sorry for silly question, but did you mean dying from sub?

And one more question. When are this subs called? As far as I can understand, isa and coerce are called when we try to set the new value. But are this subs called somewhere else?

Hi krautcat, there are no silly questions, only silly answers ;-)

yes, in this case "an exception" means that the program exits with a fatal error returned by the type checking sub if the value is not valid. When it dies it "throws an exception".

Now, as to your other question. Yes, you can use the Types to validate elsewhere. You should spend some time reading in the docs of Type::Tiny and friends (which is spread through several files).

One of the simplest ways is to make use of the auto-defined is_<type_name>() functions that Type::Tiny defines and provides in Types::Standard:

Package:

package Krautcat;
use strict; use warnings;
use Moo;
use MooX::TypeTiny;:
use Types::Standard qw/ Str is_Str /;

has foo => ( is => 'ro', isa => Str, required => 1 );
has baz => ( is => 'rw', );

sub qux {
    my $self = shift;
    my $val = shift;

    die 'not a string' if not is_Str $val;
    $self->baz( $val );

    return { baz => $self->baz };
}

1;
[download]

Script:

use strict; use warnings;
use Test::Most;

use_ok 'Krautcat', 'Loaded class';

throws_ok(
    sub { my $obj = Krautcat->new() },
    qr/Missing required arguments: foo/,
    'empty params throws ok',
);

dies_ok(
    sub { my $obj = Krautcat->new( foo => [42] ) },
    'non-string param for constructor dies ok',
);

like(
    $@,
    qr/\QReference [42] did not pass type constraint "Str"\E/,
    'assertion failure message looks ok',
);

my $obj = new_ok(
    'Krautcat' => [ foo => 'bar' ],
    'obj with valid constructor params',
);

is( $obj->foo, 'bar', 'attr has correct val from constructor' );

throws_ok(
    sub { $obj->qux( [42] ) },
    qr/not a string/,
    'non-string param for qux() throws ok',
);

lives_and(
    sub { is_deeply $obj->qux('blorg'), { baz => 'blorg' } },
    'string param for qux() validates ok',
);

done_testing;
[download]

Output:

prove -v 1199413.pl
1199413.pl .. 
ok 1 - use Krautcat;
ok 2 - empty params throws ok
ok 3 - non-string param for constructor dies ok
ok 4 - assertion failure message looks ok
ok 5 - 'obj with valid constructor params' isa 'Krautcat'
ok 6 - attr has correct val from constructor
ok 7 - non-string param for qux() throws ok
ok 8 - string param for qux() validates ok
1..8
ok
All tests successful.
Files=1, Tests=8,  0 wallclock secs ( 0.01 usr  0.01 sys +  0.08 cusr 
+ 0.01 csys =  0.11 CPU)
Result: PASS
[download]

This is the most simple feature and example I can think of; there is a lot more to discover!



The way forward always starts with a minimal test.