/usr/share/perl5/PerlConsole/Preferences.pm is in perlconsole 0.4-4.
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 | package PerlConsole::Preferences;
#
# This class hanldes all the preferences the user can change within the console.
#
use strict;
use warnings;
# The main data structure of the preferences,
# _valid_values contains list for each possible value.
sub init
{
my $self = {
_valid_values => {
output => ['scalar', 'dumper', 'yaml', 'dump', 'dds'],
},
_values => {
output => "scalar"
}
};
return $self;
}
# the help messages, dynamically built with the data structure
sub help($;$)
{
my ($self, $pref) = @_;
if (!defined $pref) {
return "You can set a preference in the console with the following syntax:\n".
":set <preference>=<value>\n".
"Available preferences are:\n\t- ".join("\n\t- ", keys(%{$self->{'_values'}}))."\n".
"see :help <preference> for details.";
}
else {
if (defined $self->{'_valid_values'}{$pref}) {
return "Valid values for preference \"$pref\" are: ".join(", ", @{$self->{'_valid_values'}{$pref}});
}
else {
return "No such preference: $pref";
}
}
}
# create an empty preference object, ready for being set
sub new
{
my ($class) = @_;
my $self = PerlConsole::Preferences::init();
bless($self, $class);
return $self;
}
# set a preference to a given value, making sure it's an available value, and
# that the value given is valid.
sub set($$$)
{
my ($self, $pref, $val) = @_;
unless (defined $self->{'_valid_values'}{$pref}) {
return 0;
}
unless (grep /$val/, @{$self->{'_valid_values'}{$pref}}) {
return 0;
}
$self->{'_values'}{$pref} = $val;
}
# retrurn the preference's value
sub get($$)
{
my ($self, $pref) = @_;
unless (exists $self->{'_values'}{$pref}) {
return 0;
}
return $self->{'_values'}{$pref};
}
# returns a list of all available preferences
sub getPreferences($)
{
my ($self) = @_;
return keys %{$self->{"_valid_values"}};
}
# returns a list of all possible values of a preference
sub getValidValues($$)
{
my ($self, $pref) = @_;
return [] unless defined $self->{'_valid_values'}{$pref};
return $self->{'_valid_values'}{$pref};
}
# END
1;
|