Comment utiliser des décorateurs en Perl ?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
sub oxa_msg_info {
    my ( $msg, $flag ) = @_;

    my $tms = ( $flag ) ? utils_timestamp() . ' - '  : '';
    say 'OXRES: ' . $tms . $msg;

    return;
}

sub oxa_msg_warn {
    my ( $msg, $flag ) = @_;

    my $tms = ( $flag ) ? utils_timestamp() . ' - '  : '';
    say "OXINC: " . $tms . "$msg";

    return;
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{
    no warnings 'redefine';
    *{xxx_utils::oxa_msg_info} = decorateur(\&info_or_warn, 'OXRES');
    *{xxx_utils::oxa_msg_warn} = decorateur(\&info_or_warn, 'OXINC');
}

sub info_or_warn {
    my ( $msg ) = @_;
    say $msg;
}

sub decorateur {
    my ( $coderef, $type_msg) = @_;
    return sub {
        my ( $msg, $flag ) = @_;
        my $tms = ( $flag ) ? utils_timestamp() . ' - '  : '';
        $coderef->($type_msg . ': ' . $tms . $msg);
    }
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
use strict;
use warnings;
use feature "say";

sub create_oxa_message {
    my $ox_what = shift;
    return sub {
        my $msg = shift;
        say "$ox_what: TMS $msg";
    }
}

*::oxa_msg_info = create_oxa_message ("OXRES: ");
*::oxa_msg_warn = create_oxa_message ("OXINC: ");

oxa_msg_info("Information");
oxa_msg_warn("Avertissement");

1
2
3
OXRES: : TMS Information
OXINC: : TMS Avertissement

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use strict;
use warnings;
use feature "say";

sub create_oxa_message {
    my $ox_what = shift;
    return sub {
        my $msg = shift;
        say "$ox_what: TMS $msg";
    }
}

my %hash = (info => "OXRES: ", warn => "OXINC: ");
{
    no strict "refs";
    *{"::oxa_msg_" . $_} = create_oxa_message ($hash{$_}) for keys %hash;
}

oxa_msg_info("Information");
oxa_msg_warn("Avertissement");