/usr/share/perl5/Package/Pkg/Lexicon.pm is in libpackage-pkg-perl 0.0020-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 | package Package::Pkg::Lexicon;
use strict;
use warnings;
use Mouse;
use Clone qw/ clone /;
has lexicon => qw/ is ro lazy_build 1 isa HashRef /;
sub _build_lexicon { {} }
has prefix => qw/ accessor _prefix isa Maybe[Str] /;
has suffix => qw/ accessor _suffix isa Maybe[Str] /;
sub prefix {
my $self = shift;
return $self->_prefix unless @_;
$self->_prefix( $_[0] );
return $self;
}
sub suffix {
my $self = shift;
return $self->_suffix unless @_;
$self->_suffix( $_[0] );
return $self;
}
sub copy {
my $self = shift;
my $lexicon;
if ( @_ ) { $lexicon = { $self->slice( @_ ) } }
else { $lexicon = clone( $self->lexicon ) }
return (ref $self)->new(
lexicon => $lexicon,
prefix => $self->prefix,
suffix => $self->suffix,
);
}
sub add {
my $self = shift;
die "Missing name & subroutine" unless @_;
while ( @_ ) {
my $name = shift;
my $subroutine = shift;
next unless defined $name and defined $subroutine;
die "Invalid name ($name)" unless $name =~ m/^\w+$/;
die "Invalid subroutine ($subroutine)" unless ref $subroutine eq 'CODE';
$self->lexicon->{$name} = $subroutine;
}
return $self;
}
sub remove {
my $self = shift;
die "Missing name" unless @_;
for my $name ( @_ ) {
next unless defined $name;
delete $self->lexicon->{$name};
}
return $self;
}
sub get {
my $self = shift;
my @namelist = @_ ? @_ : keys %{ $self->lexicon };
return map { defined $_ ? $self->lexicon->{$_} : undef } @namelist;
}
sub slice {
my $self = shift;
return %{ $self->lexicon } unless @_;
my @namelist = @_ ? @_ : keys %{ $self->lexicon };
my @valuelist = map { defined $_ ? $self->lexicon->{$_} : undef } @namelist;
my %slice;
@slice{ @namelist } = @valuelist;
return %slice;
}
sub export {
my $self = shift;
my @namelist = @_ ? @_ : keys %{ $self->lexicon };
my @valuelist = map { defined $_ ? $self->lexicon->{$_} : undef } @namelist;
if ( defined ( my $prefix = $self->prefix ) ) {
@namelist = map { defined $_ ? join '_', $prefix, $_ : undef } @namelist;
}
if ( defined ( my $suffix = $self->suffix ) ) {
@namelist = map { defined $_ ? join '_', $_, $suffix : undef } @namelist;
}
my %export;
@export{ @namelist } = @valuelist;
return %export;
}
sub filter {
my $self = shift;
}
sub map {
my $self = shift;
}
sub install {
my $self = shift;
# overwrite => 0|1
# collide => 0|1|2
}
1;
|