PageRenderTime 20ms CodeModel.GetById 16ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/src/choicetool-parser.in

#
Autoconf | 292 lines | 160 code | 59 blank | 73 comment | 17 complexity | a0a3277dbf8c24956ee82d59c20f044e MD5 | raw file
  1#! @PERL@
  2
  3#
  4# choicetool-parser
  5#
  6# Copyright (C) 2008, 2009 Francesco Salvestrini
  7#
  8# This program is free software; you can redistribute it and/or modify
  9# it under the terms of the GNU General Public License as published by
 10# the Free Software Foundation; either version 2 of the License, or
 11# (at your option) any later version.
 12#
 13# This program is distributed in the hope that it will be useful,
 14# but WITHOUT ANY WARRANTY; without even the implied warranty of
 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16# GNU General Public License for more details.
 17#
 18# You should have received a copy of the GNU General Public License along
 19# with this program; if not, write to the Free Software Foundation, Inc.,
 20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 21#
 22
 23eval 'case $# in 0) exec @PERL@ -S "$0";; *) exec @PERL@ -S "$0" "$@";; esac'
 24    if 0;
 25
 26use File::Spec;
 27
 28BEGIN
 29{
 30    # Retrieve our perl libraries path
 31    my $perllibdir;
 32
 33    $perllibdir = defined($ENV{'CHOICETOOL_LIBRARY_PATH'}) ?
 34        $ENV{'CHOICETOOL_LIBRARY_PATH'} : '@pkgvlibsdir@';
 35
 36    unshift(@INC, map(File::Spec->catfile($_, "perl"),
 37                      (split '@PATH_SEPARATOR@', $perllibdir)));
 38
 39    # Override SHELL.  On DJGPP SHELL may not be set to a shell
 40    # that can handle redirection and quote arguments correctly,
 41    # e.g.: COMMAND.COM.  For DJGPP always use the shell that configure
 42    # has detected.
 43    $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
 44}
 45
 46#
 47# Misc
 48#
 49
 50use strict;
 51use warnings;
 52use diagnostics;
 53
 54use Data::Dumper;
 55
 56use Choicetool::Autoconfig;
 57use Choicetool::Base::Trace;
 58use Choicetool::Base::Debug;
 59use Choicetool::Base::Program;
 60use Choicetool::Base::Options;
 61use Choicetool::OS::File;
 62use Choicetool::OS::String;
 63use Choicetool::OS::Home;
 64use Choicetool::OS::Environment;
 65use Choicetool::Frontends::KConfig::Parse;
 66use Choicetool::Data::Tree;
 67use Choicetool::Widgets::Widget;
 68use Choicetool::Data::Set;
 69
 70#
 71# Globals
 72#
 73
 74our $PROGRAM_NAME = "choicetool-parser";
 75
 76my $OUTBASE = "choose";
 77my $DFLTIN  = $OUTBASE . ".pp";
 78my $DFLTOUT = $OUTBASE . ".pa";
 79
 80sub help_environment ()
 81{
 82    print "The environment variables CHOICETOOL_BINARY_PATH, CHOICETOOL_LIBRARY_PATH are\n";
 83    print "honored.\n";
 84}
 85
 86sub help ()
 87{
 88    print "Usage: $PROGRAM_NAME [OPTIONS]\n";
 89    print "\n";
 90    print "Parse an input file if given, or \`$DFLTIN' if present. Output is\n";
 91    print "sent to the output file if it is given, otherwise into \`$DFLTOUT'.\n";
 92    print "\n";
 93    print "  -i, --input=FILE           get input from FILE\n";
 94    print "  -o, --output=FILE          output to file FILE\n";
 95    print "  -n, --dry-run              display actions without modifying any files\n";
 96    print "  -W, --warnings=CATEGORY    report the warnings falling in CATEGORY\n";
 97    print "  -d, --debug                run in debugging mode\n";
 98    print "  -v, --verbose              verbose mode\n";
 99    print "  -h, --help                 print this help, then exit\n";
100    print "  -V, --version              print version number, then exit\n";
101    print "\n";
102
103    help_environment();
104
105    print "\n";
106    print "Report bugs to <$PACKAGE_BUGREPORT>\n";
107}
108
109#
110# Main
111#
112
113trace_prefix_set($PROGRAM_NAME);
114
115my $input_file   = "";
116my $output_file  = "";
117my $running_mode = "";
118my $force_mode   = 0;
119my $dry_run      = 0;
120my $run          = 1;
121
122debug_set(0);
123verbose_set(0);
124warning_set("none");
125
126my $options = Choicetool::Base::Options->new();
127assert(defined($options));
128
129my @options_list = (
130    [ "i", "input",    sub { $input_file = $_[0];          return 1; }, 1 ],
131    [ "o", "output",   sub { $output_file = $_[0];         return 1; }, 1 ],
132    [ "n", "dry-run",  sub { $dry_run = 1;                 return 1; }, 0 ],
133    [ "f", "force",    sub { $force_mode = 1;              return 1; }, 0 ],
134    [ "W", "warnings", sub { warning_set($_[0]);           return 1; }, 1 ],
135    [ "d", "debug",    sub { debug_inc();                  return 1; }, 0 ],
136    [ "v", "verbose",  sub { verbose_inc();                return 1; }, 0 ],
137    [ "h", "help",     sub { help();             $run = 0; return 0; }, 0 ],
138    [ "V", "version",  sub { version();          $run = 0; return 0; }, 0 ],
139    );
140
141if (!$options->config(\@options_list)) {
142    bug("Options configuration problem (" . $options->strerror() . ")");
143}
144if (!$options->parse(\@ARGV)) {
145    hint($options->strerror());
146    exit 1;
147}
148
149my @options_slack;
150
151assert($options->{OPTIND} >= 0);
152@options_slack = @ARGV[$options->{OPTIND} .. $#ARGV];
153
154debug("Running \`" . $PROGRAM_NAME . "' version \`" . $PACKAGE_VERSION . "'");
155
156#
157# Parameters check
158#
159
160if (!$run) {
161    exit 0;
162}
163
164if ($input_file eq "") {
165    $input_file = $DFLTIN;
166}
167
168if ($output_file eq "") {
169    $output_file = $DFLTOUT;
170}
171
172if (!file_ispresent($input_file)) {
173    error("Input file \`" . $input_file . "' is missing");
174    exit 1;
175}
176
177assert(defined($input_file));
178assert(defined($output_file));
179
180#
181# Some preliminary check(s)
182#
183
184if (!$force_mode) {
185    if (!file_isnewer($input_file, $output_file)) {
186        warning("Output file "              .
187                "\`" . $output_file . "' "  .
188                "seems not to be obsolete " .
189                "(input file is "           .
190                "\`" . $input_file . "'). " .
191                "Use --force to rebuild");
192        exit 0;
193    }
194}
195
196##
197## Dump the environment, useful for debugging purposes
198##
199#{
200#    sub callback ($$)
201#    {
202#        my $key   = shift;
203#        my $value = shift;
204#
205#        if (!defined($key)) {
206#            $key = "undef";
207#        }
208#        if (!defined($value)) {
209#            $value = "undef";
210#        }
211#        debug("Environment `" . $key . "' = `" . $value . "'")
212#    }
213#    environment_foreach(\&callback)
214#}
215
216#
217# Parse the input file
218#
219
220my $ui;
221my $set;
222
223$ui = Choicetool::Widgets::Widget->new(0);
224assert(defined($ui));
225
226$set = Choicetool::Data::Set->new();
227assert(defined($set));
228
229my $string;
230$string = "";
231if (!Choicetool::Frontends::KConfig::Parse::parse($input_file, \$ui, \$set)) {
232    error("Failed to parse file `" . $input_file . "\'");
233    exit 1;
234}
235
236assert(defined($ui));
237
238{
239    my $level;
240
241    debug("Menu tree:");
242    $level = 0;
243    $ui->foreach(
244        sub {
245            my $node_ref = shift;
246
247            assert(defined($node_ref));
248
249            debug("  Menu");
250            debug("    ID:        \`" . ${$node_ref}->id() . "'");
251
252            my $parent_ref;
253
254            $parent_ref = ${$node_ref}->parent();
255            if (defined($parent_ref)) {
256                debug("    Parent ID: \`" . ${$parent_ref}->id() . "'");
257            }
258
259            debug("");
260        }
261        );
262}
263
264#
265# NOTE: Tree packing will be performed later on
266#
267
268#
269# Freeze the parsed data structure to string
270#
271
272my %data;
273$data{TREE} = $ui;
274
275$string = Data::Dumper->Dump([ \%data ], [ qw(*data) ]);
276
277#debug("Frozen data:");
278#debug("\`" . $string . "'");
279
280#
281# Write output file at last
282#
283
284if ($dry_run) {
285    exit 0;
286}
287
288if (!string_tofile($string, $output_file)) {
289    exit 1;
290}
291
292exit 0;