/usr/share/perl5/Parse/Yapp/Options.pm is in libparse-yapp-perl 1.05-12.
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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | #
# Module Parse::Yapp::Options
#
# (c) Copyright 1999-2001 Francois Desarmenien, all rights reserved.
# (see the pod text in Parse::Yapp module for use and distribution rights)
#
package Parse::Yapp::Options;
use strict;
use Carp;
############################################################################
#Definitions of options
#
# %known_options allowed options
#
# %default_options default
#
# %actions sub refs to execute if option is set with ($self,$value)
# as parameters
############################################################################
#
#A value of '' means any value can do
#
my(%known_options)= (
language => {
perl => "Ouput parser for Perl language",
# for future use...
# 'c++' => "Output parser for C++ language",
# c => "Output parser for C language"
},
linenumbers => {
0 => "Don't embbed line numbers in parser",
1 => "Embbed source line numbers in parser"
},
inputfile => {
'' => "Input file name: will automagically fills input"
},
classname => {
'' => "Class name of parser object (Perl and C++)"
},
standalone => {
0 => "Don't create a standalone parser (Perl and C++)",
1 => "Create a standalone parser"
},
input => {
'' => "Input text of grammar"
},
template => {
'' => "Template text for generating grammar file"
},
);
my(%default_options)= (
language => 'perl',
linenumbers => 1,
inputfile => undef,
classname => 'Parser',
standalone => 0,
input => undef,
template => undef,
shebang => undef,
);
my(%actions)= (
inputfile => \&__LoadFile
);
#############################################################################
#
# Actions
#
# These are NOT a method, although they look like...
#
# They are super-private routines (that's why I prepend __ to their names)
#
#############################################################################
sub __LoadFile {
my($self,$filename)=@_;
open(IN,"<$filename")
or croak "Cannot open input file '$filename' for reading";
$self->{OPTIONS}{input}=join('',<IN>);
close(IN);
}
#############################################################################
#
# Private methods
#
#############################################################################
sub _SetOption {
my($self)=shift;
my($key,$value)=@_;
$key=lc($key);
@_ == 2
or croak "Invalid number of arguments";
exists($known_options{$key})
or croak "Unknown option: '$key'";
if(exists($known_options{$key}{lc($value)})) {
$value=lc($value);
}
elsif(not exists($known_options{$key}{''})) {
croak "Invalid value '$value' for option '$key'";
}
exists($actions{$key})
and &{$actions{$key}}($self,$value);
$self->{OPTIONS}{$key}=$value;
}
sub _GetOption {
my($self)=shift;
my($key)=map { lc($_) } @_;
@_ == 1
or croak "Invalid number of arguments";
exists($known_options{$key})
or croak "Unknown option: '$key'";
$self->{OPTIONS}{$key};
}
#############################################################################
#
# Public methods
#
#############################################################################
#
# Constructor
#
sub new {
my($class)=shift;
my($self)={ OPTIONS => { %default_options } };
ref($class)
and $class=ref($class);
bless($self,$class);
$self->Options(@_);
$self;
}
#
# Specify one or more options to set
#
sub Options {
my($self)=shift;
my($key,$value);
@_ % 2 == 0
or croak "Invalid number of arguments";
while(($key,$value)=splice(@_,0,2)) {
$self->_SetOption($key,$value);
}
}
#
# Set (2 parameters) or Get (1 parameter) values for one option
#
sub Option {
my($self)=shift;
my($key,$value)=@_;
@_ == 1
and return $self->_GetOption($key);
@_ == 2
and return $self->_SetOption($key,$value);
croak "Invalid number of arguments";
}
1;
|