1 #

     2 # Module Parse::Yapp::Options

     3 #

     4 # (c) Copyright 1999-2001 Francois Desarmenien, all rights reserved.

     5 # (see the pod text in Parse::Yapp module for use and distribution rights)

     6 #

     7 package Parse::Yapp::Options;

     8 

     9 use strict;

    10 use Carp;

    11 

    12 ############################################################################

    13 #Definitions of options

    14 #

    15 # %known_options    allowed options

    16 #

    17 # %default_options  default

    18 #

    19 # %actions          sub refs to execute if option is set with ($self,$value)

    20 #                   as parameters

    21 ############################################################################

    22 #

    23 #A value of '' means any value can do

    24 #

    25 my(%known_options)= (

    26     language    =>  {

    27         perl    => "Ouput parser for Perl language",

    28 # for future use...

    29 #       'c++'   =>  "Output parser for C++ language",

    30 #       c       =>  "Output parser for C language"

    31     },

    32     linenumbers =>  {

    33         0       =>  "Don't embbed line numbers in parser",

    34         1       =>  "Embbed source line numbers in parser"

    35     },

    36     inputfile   =>  {

    37         ''      =>  "Input file name: will automagically fills input"

    38     },

    39     classname   =>  {

    40         ''      =>  "Class name of parser object (Perl and C++)"

    41     },

    42     standalone  =>  {

    43         0       =>  "Don't create a standalone parser (Perl and C++)",

    44         1       =>  "Create a standalone parser"

    45     },

    46     input       =>  {

    47         ''      =>  "Input text of grammar"

    48     },

    49     template    => {

    50         ''      =>  "Template text for generating grammar file"

    51     },

    52 );

    53 

    54 my(%default_options)= (

    55     language => 'perl',

    56     linenumbers => 1,

    57     inputfile => undef,

    58     classname   => 'Parser',

    59     standalone => 0,

    60     input => undef,

    61     template => undef,

    62     shebang => undef,

    63 );

    64 

    65 my(%actions)= (

    66     inputfile => \&__LoadFile

    67 );

    68 

    69 #############################################################################

    70 #

    71 # Actions

    72 #

    73 # These are NOT a method, although they look like...

    74 #

    75 # They are super-private routines (that's why I prepend __ to their names)

    76 #

    77 #############################################################################

    78 sub __LoadFile {

    79     my($self,$filename)=@_;

    80 

    81         open(IN,"<$filename")

    82     or  croak "Cannot open input file '$filename' for reading";

    83     $self->{OPTIONS}{input}=join('',<IN>);

    84     close(IN);

    85 }

    86 

    87 #############################################################################

    88 #

    89 # Private methods

    90 #

    91 #############################################################################

    92 

    93 sub _SetOption {

    94     my($self)=shift;

    95     my($key,$value)=@_;

    96 

    97     $key=lc($key);

    98 

    99         @_ == 2

   100     or  croak "Invalid number of arguments";

   101 

   102         exists($known_options{$key})

   103     or  croak "Unknown option: '$key'";

   104 

   105     if(exists($known_options{$key}{lc($value)})) {

   106         $value=lc($value);

   107     }

   108     elsif(not exists($known_options{$key}{''})) {

   109         croak "Invalid value '$value' for option '$key'";

   110     }

   111 

   112         exists($actions{$key})

   113     and &{$actions{$key}}($self,$value);

   114 

   115     $self->{OPTIONS}{$key}=$value;

   116 }

   117 

   118 sub _GetOption {

   119     my($self)=shift;

   120     my($key)=map { lc($_) } @_;

   121 

   122         @_ == 1

   123     or  croak "Invalid number of arguments";

   124 

   125         exists($known_options{$key})

   126     or  croak "Unknown option: '$key'";

   127 

   128     $self->{OPTIONS}{$key};

   129 }

   130 

   131 #############################################################################

   132 #

   133 # Public methods

   134 #

   135 #############################################################################

   136 

   137 #

   138 # Constructor

   139 #

   140 sub new {

   141     my($class)=shift;

   142     my($self)={ OPTIONS => { %default_options } };

   143 

   144         ref($class)

   145     and $class=ref($class);

   146     

   147     bless($self,$class);

   148 

   149     $self->Options(@_);

   150 

   151     $self;

   152 }

   153 

   154 #

   155 # Specify one or more options to set

   156 #

   157 sub Options {

   158     my($self)=shift;

   159     my($key,$value);

   160 

   161         @_ % 2 == 0

   162     or  croak "Invalid number of arguments";

   163 

   164     while(($key,$value)=splice(@_,0,2)) {

   165         $self->_SetOption($key,$value);

   166     }

   167 }

   168 

   169 #

   170 # Set (2 parameters) or Get (1 parameter) values for one option

   171 #

   172 sub Option {

   173     my($self)=shift;

   174     my($key,$value)=@_;

   175 

   176         @_ == 1

   177     and return $self->_GetOption($key);

   178 

   179         @_ == 2

   180     and return $self->_SetOption($key,$value);

   181 

   182     croak "Invalid number of arguments";

   183 

   184 }

   185 

   186 1;