File Coverage

blib/lib/App/VTide/Hooks.pm
Criterion Covered Total %
statement 37 37 100.0
branch 8 10 80.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 55 57 96.4


line stmt bran cond sub pod time code
1             package App::VTide::Hooks;
2              
3             # Created on: 2016-04-07 16:42:42
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 6     6   41 use Moo;
  6         14  
  6         40  
10 6     6   15092 use warnings;
  6         13  
  6         166  
11 6     6   29 use version;
  6         12  
  6         47  
12 6     6   360 use Carp;
  6         46  
  6         317  
13 6     6   4154 use Data::Dumper qw/Dumper/;
  6         43109  
  6         374  
14 6     6   45 use English qw/ -no_match_vars /;
  6         13  
  6         33  
15 6     6   1982 use Path::Tiny;
  6         28  
  6         1818  
16              
17             our $VERSION = version->new('1.0.2');
18              
19             has hook_cmds => (
20             is => 'rw',
21             lazy => 1,
22             builder => '_hook_cmds',
23             );
24             has vtide => (
25             is => 'rw',
26             required => 1,
27             handles => [qw/ config hooks /],
28             );
29              
30             sub run {
31 2     2 1 1995 my ($self, $hook, @args) = @_;
32              
33 2 100       43 if ( $self->hook_cmds->{$hook} ) {
34 1         24 $self->hook_cmds->{$hook}->($self, @args);
35             }
36              
37 2         16 return;
38             }
39              
40             sub _hook_cmds {
41 2     2   849 my ($self) = @_;
42 2         4 my $hooks = {};
43 2         35 my $global = path( $self->config->global_config )->parent->path('hooks.pl')->absolute;
44 2         633 my $local = path( $self->config->local_config )->parent->path('.vtide', 'hooks.pl')->absolute;
45              
46 2 100       485 if ( -f $global ) {
47 1         32 $hooks = do $global;
48             }
49 2 100       431 if ( -f $local ) {
50 1         33 my $done = do $local;
51 1 50       342 $hooks = { %{ $hooks || {} }, %{ $done || {} } };
  1 50       8  
  1         5  
52             }
53              
54 2         41 return $hooks;
55             }
56              
57             1;
58              
59             __END__
60              
61             =head1 NAME
62              
63             App::VTide::Hooks - Manage code hooks for APP::VTide
64              
65             =head1 VERSION
66              
67             This documentation refers to App::VTide::Hooks version 1.0.2
68              
69             =head1 SYNOPSIS
70              
71             use App::VTide::Hooks;
72              
73             # Brief but working code example(s) here showing the most common usage(s)
74             # This section will be as far as many users bother reading, so make it as
75             # educational and exemplary as possible.
76              
77             =head1 DESCRIPTION
78              
79             This module provides the basis from running user defined hooks. Those hooks
80             are located in the C<~/.vtide/hooks.pl> and C<$PROJECT/.vtide/hooks.pl> files.
81             They are perl files that are expected to return a hash where the keys are the
82             hook names and the values are subs to be run. Details about individual hooks
83             can be found in the various sub-command modules.
84              
85             =head1 SUBROUTINES/METHODS
86              
87             =head2 C<run ( $hook, @args )>
88              
89             The the hook C<$hook> with the supplied arguments.
90              
91             =head1 ATTRIBUTES
92              
93             =head2 vtide
94              
95             Reference to the vtide object
96              
97             =head2 hook_cmds
98              
99             Hash of configured hook subroutines
100              
101             =head1 DIAGNOSTICS
102              
103             =head1 CONFIGURATION AND ENVIRONMENT
104              
105             =head1 DEPENDENCIES
106              
107             =head1 INCOMPATIBILITIES
108              
109             =head1 BUGS AND LIMITATIONS
110              
111             There are no known bugs in this module.
112              
113             Please report problems to Ivan Wills (ivan.wills@gmail.com).
114              
115             Patches are welcome.
116              
117             =head1 AUTHOR
118              
119             Ivan Wills - (ivan.wills@gmail.com)
120              
121             =head1 LICENSE AND COPYRIGHT
122              
123             Copyright (c) 2016 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
124             All rights reserved.
125              
126             This module is free software; you can redistribute it and/or modify it under
127             the same terms as Perl itself. See L<perlartistic>. This program is
128             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
129             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
130             PARTICULAR PURPOSE.
131              
132             =cut