/usr/share/perl5/CipUX/CAT/Web/Plugin.pm is in libcipux-cat-web-perl 3.4.0.3-4.2.
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 | package CipUX::CAT::Web::Plugin;
use warnings;
use strict;
use Class::Std;
use English qw( -no_match_vars);
use Readonly;
use Module::Pluggable
search_path => ['CipUX::CAT::Web::Module'],
instantiate => 'new',
sub_name => 'register';
use base qw(CipUX);
{
use version; our $VERSION = qv('3.4.0.3');
use re 'taint'; # Keep data captured by parens tainted
delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
# CONST
Readonly::Scalar my $EMPTY_STRING => q{};
# GLOBAL
my $module_name_register_hr = {};
my $module_cfg_register_hr = {};
# METHOD
sub init {
my $self = shift;
foreach my $module ( $self->register ) {
next until $module->can('register');
$module->register();
}
return;
}
sub set_module_name_register {
my ( $self, $arg_r ) = @_;
my $class
= exists $arg_r->{class}
? $self->l( $arg_r->{class} )
: $self->perr('class');
my $name
= exists $arg_r->{name}
? $self->l( $arg_r->{name} )
: $self->perr('name');
$module_name_register_hr->{$name} = $class;
return;
}
# returns Perl Module name for registers names
sub get_module_name_register {
if (wantarray) {
return keys %{$module_name_register_hr};
}
return $module_name_register_hr;
}
sub set_module_cfg_register {
my ( $self, $arg_r ) = @_;
my $cfg_ar
= exists $arg_r->{cfg_ar}
? $arg_r->{cfg_ar}
: $self->perr('cfg_ar');
my $name
= exists $arg_r->{name}
? $self->l( $arg_r->{name} )
: $self->perr('name');
foreach my $ar ( @{$cfg_ar} ) { # cumulated by class::std
# should be excactly one hash ref in one array ref:
foreach my $hr ( @{$ar} ) { # need because of class::std
# simple merge:
foreach my $attr ( sort keys %{$hr} ) {
#print "MT ATTR[$attr]\n";
$module_cfg_register_hr->{$name}->{$attr} = $hr->{$attr};
}
}
}
return;
}
sub get_module_cfg_register {
my ( $self, $arg_r ) = @_;
my $name
= exists $arg_r->{name}
? $self->l( $arg_r->{name} )
: undef;
if ( defined $name and exists $module_cfg_register_hr->{$name} ) {
return $module_cfg_register_hr->{$name};
}
return $module_cfg_register_hr;
}
}
1;
__END__
|