# PiFlash::Hook - named dispatch/hook library for PiFlash # by Ian Kluft use strict; use warnings; use v5.14.0; # require 2011 or newer version of Perl package PiFlash::Hook; $PiFlash::Hook::VERSION = '0.4.3'; use Carp qw(confess); use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) use parent 'PiFlash::Object'; use PiFlash::State; # ABSTRACT: named dispatch/hook library for PiFlash # initialize hooks hash as empty ## no critic (ProhibitPackageVars) our %hooks; ## use critic # required parameter list # used by PiFlash::Object for new() method sub object_params { return qw(name code origin); } # use AUTOLOAD to call a named hook as if it were a class method our $AUTOLOAD; sub AUTOLOAD { my $self = shift; # Remove qualifier from original method name... my $called = $AUTOLOAD =~ s/.*:://r; # differentiate between class and instance methods if (defined $self and ref $self eq "PiFlash::Hook") { # handle instance accessor # if likely to be used a lot, optimize this by creating accessor function upon first access if (exists $self->{$called}) { return $self->{$called}; } return; } else { # autoloaded class methods run hooks by name run($called, @_); } } # add a code reference to a named hook sub add { my $name = shift; my $coderef = shift; if (ref $coderef ne "CODE") { confess "PiFlash::Hook::add_hook(): can't add $name hook with non-code reference"; } if (!exists $hooks{$name}) { $hooks{$name} = []; } push @{$hooks{$name}}, PiFlash::Hook::new({name => $name, code => $coderef, origin => [caller]}); } # check if there are any hooks registered for a name sub has { my $name = shift; return exists $hooks{$name}; } # run the hook code sub run { my $name = shift; # Is there a hook of that name? if (!exists $hooks{$name}) { if (PiFlash::State::verbose()) { say "PiFlash::Hook dispatch: no such hook $name - ignored"; } return; } # call all functions registered in the list for this hook my @result; if (ref $hooks{$name} eq "ARRAY") { foreach my $hook (@{$hooks{$name}}) { push @result, $hook->{code}(@_); } } return @result; } 1; __END__ =pod =encoding UTF-8 =head1 NAME PiFlash::Hook - named dispatch/hook library for PiFlash =head1 VERSION version 0.4.3 =head1 SYNOPSIS PiFlash::Hook::add( "hook1", sub { ... code ... }); PiFlash::Hook::hook1(); PiFlash::Hook::add( "hook2", \&function_name); PiFlash::Hook::hook2(); =head1 DESCRIPTION =head1 SEE ALSO L, L, L, L, L =head1 AUTHOR Ian Kluft =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2017-2019 by Ian Kluft. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut