/usr/share/perl5/Dancer2/Core/Role/Hookable.pm is in libdancer2-perl 0.166001+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | package Dancer2::Core::Role::Hookable;
# ABSTRACT: Role for hookable objects
$Dancer2::Core::Role::Hookable::VERSION = '0.166001';
use Moo::Role;
use Dancer2::Core;
use Dancer2::Core::Types;
use Carp 'croak';
use Safe::Isa;
requires 'supported_hooks', 'hook_aliases';
# The hooks registry
has hooks => (
is => 'ro',
isa => HashRef,
builder => '_build_hooks',
lazy => 1,
);
sub BUILD { }
# after a hookable object is built, we go over its postponed hooks and register
# them if any.
after BUILD => sub {
my ( $self, $args ) = @_;
$self->_add_postponed_hooks($args)
if defined $args->{postponed_hooks};
};
sub _add_postponed_hooks {
my ( $self, $args ) = @_;
my $postponed_hooks = $args->{postponed_hooks};
# find the internal name of the hooks, from the caller name
my $caller = ref($self);
my ( $dancer, $h_type, $h_name, @rest ) = map lc, split /::/, $caller;
$h_name = $rest[0] if $h_name eq 'role';
if ( $h_type =~ /(template|logger|serializer|session)/ ) {
$h_name = $h_type;
$h_type = 'engine';
}
# keep only the hooks we want
$postponed_hooks = $postponed_hooks->{$h_type}{$h_name};
return unless defined $postponed_hooks;
foreach my $name ( keys %{$postponed_hooks} ) {
my $hook = $postponed_hooks->{$name}{hook};
my $caller = $postponed_hooks->{$name}{caller};
$self->has_hook($name)
or croak "$h_name $h_type does not support the hook `$name'. ("
. join( ", ", @{$caller} ) . ")";
$self->add_hook($hook);
}
}
# mst++ for the hint
sub _build_hooks {
my ($self) = @_;
my %hooks = map +( $_ => [] ), $self->supported_hooks;
return \%hooks;
}
# This binds a coderef to an installed hook if not already
# existing
sub add_hook {
my ( $self, $hook ) = @_;
my $name = $hook->name;
my $code = $hook->code;
croak "Unsupported hook '$name'"
unless $self->has_hook($name);
push @{ $self->hooks->{$name} }, $code;
}
# allows the caller to replace the current list of hooks at the given position
# this is useful if the object where this role is composed wants to compile the
# hooks.
sub replace_hook {
my ( $self, $position, $hooks ) = @_;
croak "Hook '$position' must be installed first"
unless $self->has_hook($position);
$self->hooks->{$position} = $hooks;
}
# Boolean flag to tells if the hook is registered or not
sub has_hook {
my ( $self, $hook_name ) = @_;
return exists $self->hooks->{$hook_name};
}
# Execute the hook at the given position
sub execute_hook {
my $self = shift;
my $name = shift;
$name and !ref $name
or croak "execute_hook needs a hook name";
$name = $self->hook_aliases->{$name}
if exists $self->hook_aliases->{$name};
croak "Hook '$name' does not exist"
if !$self->has_hook($name);
$self->$_isa('Dancer2::Core::App') &&
$self->log( core => "Entering hook $name" );
for my $hook ( @{ $self->hooks->{$name} } ) {
$hook->(@_);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Dancer2::Core::Role::Hookable - Role for hookable objects
=head1 VERSION
version 0.166001
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Alexis Sukrieh.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|