This file is indexed.

/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;