File: build_args_hooks.t

package info (click to toggle)
libmoox-buildargs-perl 0.08-4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 144 kB
  • sloc: perl: 300; makefile: 2
file content (43 lines) | stat: -rwxr-xr-x 851 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#!/usr/bin/env perl
use 5.008001;
use strictures 2;
use Test2::V0;

{
    package Foo;
    use 5.008001;
    use strictures 2;

    use Moo;
    with 'MooX::BuildArgsHooks';

    has bar => (is=>'ro');

    around NORMALIZE_BUILDARGS => sub{
        my ($orig, $class, @args) = @_;
        @args = $class->$orig( @args );
        return( bar=>$args[0] ) if @args==1 and ref($args[0]) ne 'HASH';
        return @args;
    };

    around TRANSFORM_BUILDARGS => sub{
        my ($orig, $class, $args) = @_;
        $args = $class->$orig( $args );
        $args->{bar} = ($args->{bar}||0) + 10;
        return $args;
    };

    around FINALIZE_BUILDARGS => sub{
        my ($orig, $class, $args) = @_;
        $args = $class->$orig( $args );
        $args->{bar}++;
        return $args;
    };
}

is(
    Foo->new( 3 )->bar(),
    14,
);

done_testing;