/src/choicetool-parser.in
Autoconf | 292 lines | 160 code | 59 blank | 73 comment | 17 complexity | a0a3277dbf8c24956ee82d59c20f044e MD5 | raw file
Possible License(s): GPL-2.0
- #! @PERL@
- #
- # choicetool-parser
- #
- # Copyright (C) 2008, 2009 Francesco Salvestrini
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License along
- # with this program; if not, write to the Free Software Foundation, Inc.,
- # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- #
- eval 'case $# in 0) exec @PERL@ -S "$0";; *) exec @PERL@ -S "$0" "$@";; esac'
- if 0;
- use File::Spec;
- BEGIN
- {
- # Retrieve our perl libraries path
- my $perllibdir;
- $perllibdir = defined($ENV{'CHOICETOOL_LIBRARY_PATH'}) ?
- $ENV{'CHOICETOOL_LIBRARY_PATH'} : '@pkgvlibsdir@';
- unshift(@INC, map(File::Spec->catfile($_, "perl"),
- (split '@PATH_SEPARATOR@', $perllibdir)));
- # Override SHELL. On DJGPP SHELL may not be set to a shell
- # that can handle redirection and quote arguments correctly,
- # e.g.: COMMAND.COM. For DJGPP always use the shell that configure
- # has detected.
- $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
- }
- #
- # Misc
- #
- use strict;
- use warnings;
- use diagnostics;
- use Data::Dumper;
- use Choicetool::Autoconfig;
- use Choicetool::Base::Trace;
- use Choicetool::Base::Debug;
- use Choicetool::Base::Program;
- use Choicetool::Base::Options;
- use Choicetool::OS::File;
- use Choicetool::OS::String;
- use Choicetool::OS::Home;
- use Choicetool::OS::Environment;
- use Choicetool::Frontends::KConfig::Parse;
- use Choicetool::Data::Tree;
- use Choicetool::Widgets::Widget;
- use Choicetool::Data::Set;
- #
- # Globals
- #
- our $PROGRAM_NAME = "choicetool-parser";
- my $OUTBASE = "choose";
- my $DFLTIN = $OUTBASE . ".pp";
- my $DFLTOUT = $OUTBASE . ".pa";
- sub help_environment ()
- {
- print "The environment variables CHOICETOOL_BINARY_PATH, CHOICETOOL_LIBRARY_PATH are\n";
- print "honored.\n";
- }
- sub help ()
- {
- print "Usage: $PROGRAM_NAME [OPTIONS]\n";
- print "\n";
- print "Parse an input file if given, or \`$DFLTIN' if present. Output is\n";
- print "sent to the output file if it is given, otherwise into \`$DFLTOUT'.\n";
- print "\n";
- print " -i, --input=FILE get input from FILE\n";
- print " -o, --output=FILE output to file FILE\n";
- print " -n, --dry-run display actions without modifying any files\n";
- print " -W, --warnings=CATEGORY report the warnings falling in CATEGORY\n";
- print " -d, --debug run in debugging mode\n";
- print " -v, --verbose verbose mode\n";
- print " -h, --help print this help, then exit\n";
- print " -V, --version print version number, then exit\n";
- print "\n";
- help_environment();
- print "\n";
- print "Report bugs to <$PACKAGE_BUGREPORT>\n";
- }
- #
- # Main
- #
- trace_prefix_set($PROGRAM_NAME);
- my $input_file = "";
- my $output_file = "";
- my $running_mode = "";
- my $force_mode = 0;
- my $dry_run = 0;
- my $run = 1;
- debug_set(0);
- verbose_set(0);
- warning_set("none");
- my $options = Choicetool::Base::Options->new();
- assert(defined($options));
- my @options_list = (
- [ "i", "input", sub { $input_file = $_[0]; return 1; }, 1 ],
- [ "o", "output", sub { $output_file = $_[0]; return 1; }, 1 ],
- [ "n", "dry-run", sub { $dry_run = 1; return 1; }, 0 ],
- [ "f", "force", sub { $force_mode = 1; return 1; }, 0 ],
- [ "W", "warnings", sub { warning_set($_[0]); return 1; }, 1 ],
- [ "d", "debug", sub { debug_inc(); return 1; }, 0 ],
- [ "v", "verbose", sub { verbose_inc(); return 1; }, 0 ],
- [ "h", "help", sub { help(); $run = 0; return 0; }, 0 ],
- [ "V", "version", sub { version(); $run = 0; return 0; }, 0 ],
- );
- if (!$options->config(\@options_list)) {
- bug("Options configuration problem (" . $options->strerror() . ")");
- }
- if (!$options->parse(\@ARGV)) {
- hint($options->strerror());
- exit 1;
- }
- my @options_slack;
- assert($options->{OPTIND} >= 0);
- @options_slack = @ARGV[$options->{OPTIND} .. $#ARGV];
- debug("Running \`" . $PROGRAM_NAME . "' version \`" . $PACKAGE_VERSION . "'");
- #
- # Parameters check
- #
- if (!$run) {
- exit 0;
- }
- if ($input_file eq "") {
- $input_file = $DFLTIN;
- }
- if ($output_file eq "") {
- $output_file = $DFLTOUT;
- }
- if (!file_ispresent($input_file)) {
- error("Input file \`" . $input_file . "' is missing");
- exit 1;
- }
- assert(defined($input_file));
- assert(defined($output_file));
- #
- # Some preliminary check(s)
- #
- if (!$force_mode) {
- if (!file_isnewer($input_file, $output_file)) {
- warning("Output file " .
- "\`" . $output_file . "' " .
- "seems not to be obsolete " .
- "(input file is " .
- "\`" . $input_file . "'). " .
- "Use --force to rebuild");
- exit 0;
- }
- }
- ##
- ## Dump the environment, useful for debugging purposes
- ##
- #{
- # sub callback ($$)
- # {
- # my $key = shift;
- # my $value = shift;
- #
- # if (!defined($key)) {
- # $key = "undef";
- # }
- # if (!defined($value)) {
- # $value = "undef";
- # }
- # debug("Environment `" . $key . "' = `" . $value . "'")
- # }
- # environment_foreach(\&callback)
- #}
- #
- # Parse the input file
- #
- my $ui;
- my $set;
- $ui = Choicetool::Widgets::Widget->new(0);
- assert(defined($ui));
- $set = Choicetool::Data::Set->new();
- assert(defined($set));
- my $string;
- $string = "";
- if (!Choicetool::Frontends::KConfig::Parse::parse($input_file, \$ui, \$set)) {
- error("Failed to parse file `" . $input_file . "\'");
- exit 1;
- }
- assert(defined($ui));
- {
- my $level;
- debug("Menu tree:");
- $level = 0;
- $ui->foreach(
- sub {
- my $node_ref = shift;
- assert(defined($node_ref));
- debug(" Menu");
- debug(" ID: \`" . ${$node_ref}->id() . "'");
- my $parent_ref;
- $parent_ref = ${$node_ref}->parent();
- if (defined($parent_ref)) {
- debug(" Parent ID: \`" . ${$parent_ref}->id() . "'");
- }
- debug("");
- }
- );
- }
- #
- # NOTE: Tree packing will be performed later on
- #
- #
- # Freeze the parsed data structure to string
- #
- my %data;
- $data{TREE} = $ui;
- $string = Data::Dumper->Dump([ \%data ], [ qw(*data) ]);
- #debug("Frozen data:");
- #debug("\`" . $string . "'");
- #
- # Write output file at last
- #
- if ($dry_run) {
- exit 0;
- }
- if (!string_tofile($string, $output_file)) {
- exit 1;
- }
- exit 0;