File Coverage

blib/lib/Parse/Yapp/Options.pm

Criterion	Covered	Total	%
statement	34	43	79.0
branch	10	24	41.6
condition			n/a
subroutine	7	8	87.5
pod	0	3	0.0
total	51	78	65.3

#
# Module Parse::Yapp::Options
#
# Copyright © 1998, 1999, 2000, 2001, Francois Desarmenien.
# Copyright © 2017 William N. Braswell, Jr.
# (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('',);
    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;