File Coverage

blib/lib/CTK/Plugin.pm
Criterion Covered Total %
statement 34 35 97.1
branch 3 6 50.0
condition 3 4 75.0
subroutine 8 9 88.8
pod 2 2 100.0
total 50 56 89.2


line stmt bran cond sub pod time code
1             package CTK::Plugin;
2 3     3   21 use strict;
  3         7  
  3         77  
3 3     3   12 use utf8;
  3         6  
  3         10  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Plugin - Base class for CTK plugins writing
10              
11             =head1 VERSION
12              
13             Version 1.01
14              
15             =head1 SYNOPSIS
16              
17             package CTK::Plugin::Foo;
18             use strict;
19             use base qw/CTK::Plugin/;
20              
21             sub init {
22             my $self = shift; # It is CTK object!
23             ...
24             return 1; # or 0 if errors
25             }
26              
27             __PACKAGE__->register_method(
28             namespace => "CTK", # Optional. Default: CTK
29             method => "foo",
30             callback => sub {
31             my $self = shift; # It is CTK object!
32             ...
33             return 1;
34             });
35              
36             1;
37              
38             =head1 DESCRIPTION
39              
40             A "plugin" for the CTK is simply a Perl module which exists in a known package
41             location (CTK::Plugin::*) and conforms to a our standard, allowing it to be
42             loaded and used automatically. See L for example
43              
44             =head2 init
45              
46             Allows you to initialize your plugin
47              
48             The method is automatically call in CTK constructor. The first param is CTK object.
49             The method MUST return 0 in case of failure or 1 in case of successful initialization
50              
51             =head2 register_method
52              
53             __PACKAGE__->register_method(
54             namespace => "CTK", # Optional. Default: CTK
55             method => "mothod_name",
56             callback => sub {
57             my $self = shift; # It is CTK object!
58             ...
59             return 1;
60             });
61              
62             Allows register the method that will be linked with Your plugin callback function
63              
64             =head1 HISTORY
65              
66             =over 8
67              
68             =item B<1.00 Wed 1 May 00:20:20 MSK 2019>
69              
70             Init version
71              
72             =back
73              
74             See C file
75              
76             =head1 TO DO
77              
78             See C file
79              
80             =head1 BUGS
81              
82             * none noted
83              
84             =head1 SEE ALSO
85              
86             L
87              
88             =head1 AUTHOR
89              
90             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
91              
92             =head1 COPYRIGHT
93              
94             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
95              
96             =head1 LICENSE
97              
98             This program is free software; you can redistribute it and/or
99             modify it under the same terms as Perl itself.
100              
101             See C file and L
102              
103             =cut
104              
105 3     3   100 use vars qw/ $VERSION /;
  3         6  
  3         129  
106             $VERSION = '1.01';
107              
108             use constant {
109 3         564 NAMESPACE => "CTK",
110 3     3   13 };
  3         5  
111              
112 2     2 1 6 sub init { 1 }
113             sub register_method {
114 40     40 1 62 my $package = shift;
115 40         90 my %meta = @_;
116 40   100     118 my $namespace = $meta{namespace} || NAMESPACE;
117 40   50 0   80 my $callback = $meta{callback} || sub { 1 };
  0            
118 40 50       69 return unless ref($callback) eq "CODE";
119 40         51 my $method = $meta{method};
120 40 50       58 return unless $method;
121 40         98 my $ff = sprintf("%s::%s", $namespace, $method);
122              
123             # Check
124 3 50   3   19 return if do { no strict 'refs'; defined &{$ff} };
  3         15  
  3         153  
  40         46  
  40         41  
  40         170  
125              
126             # Create method!
127 40         48 do {
128 3     3   13 no strict 'refs';
  3         5  
  3         197  
129 40         51 *{$ff} = \&$callback;
  40         146  
130             };
131 40         94 return 1;
132             }
133              
134             1;
135              
136             __END__