#!/usr/bin/perl

# Copyright 1998, 1999 by Marcus Brinkmann <Marcus.Brinkmann@ruhr-uni-bochum.de>
#
# minor changes by Branden Robinson <branden@debian.org>
#
#  Permission is hereby granted, free of charge, to any person obtaining
#  a copy of this software and associated documentation files (the
#  "Software"), to deal in the Software without restriction, including
#  without limitation the rights to use, copy, modify, merge, publish,
#  distribute, sublicense, and/or sell copies of the Software, and to
#  permit persons to whom the Software is furnished to do so, subject to
#  the following conditions:
#
#  The above copyright notice and this permission notice shall be
#  included in all copies or substantial portions of the Software.
#
#  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
#  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
#  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
#  IN NO EVENT SHALL MARCUS BRINKMANN, BRANDEN ROBINSON, OR SOFTWARE IN THE
#  PUBLIC INTEREST, INC., BE LIABLE FOR ANY CLAIM, DAMAGES
#  OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
#  OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
#  THE USE OR OTHER DEALINGS IN THE SOFTWARE.

# ********************************* NOTE *************************************
# The inlined perl module is NOT licensed under the terms above -- see its
# license below.
# ****************************************************************************

# use Getopt::Long;
#
# We inline this module, because it is in perl but not in the perl-base
# Debian package, and we don't want to depend on perl. This duplicates a
# small amount of code, but I'll also try to get Getopt into perl-base.
# BR: update -- it's starting to look like that won't happen.
#
# Note: I stripped comments and documentation.
# Please refer to the original file.
# I also commented out the package instruction and the use strict.

# *************** BEGINNING OF CODE LICENSED UNDER GNU GPL *******************

# GetOpt::Long.pm -- Universal options parsing

# package Getopt::Long;

# RCS Status      : $Id: GetoptLong.pm,v 2.11 1997-09-17 12:23:51+02 jv Exp $
# Author          : Johan Vromans
# Created On      : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
# Last Modified On: Wed Sep 17 12:20:10 1997
# Update Count    : 608
# Status          : Released

################ Copyright ################

# This program is Copyright 1990,1997 by Johan Vromans.
# 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.
# 
# If you do not have a copy of the GNU General Public License write to
# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
# MA 02139, USA.

# use strict;
BEGIN {
    require 5.003;
    use Exporter ();
    use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION   = sprintf("%d.%02d", q$Revision: 2.11 $ =~ /(\d+)\.(\d+)/);

    @ISA       = qw(Exporter);
    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
    %EXPORT_TAGS = ();
    @EXPORT_OK = qw();
}

use vars @EXPORT, @EXPORT_OK;
use vars qw($error $debug $major_version $minor_version);
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
	    $passthrough);

my $gen_prefix;
my $argend;
my %opctl;
my %bopctl;
my @opctl;
my $pkg;
my %aliases;
my $genprefix;
my $opt;
my $arg;
my $array;
my $hash;
my $key;
my $config_defaults;
my $find_option;

sub GetOptions {

    my @optionlist = @_;
    $argend = '--';
    %opctl = ();
    %bopctl = ();
    $pkg = (caller)[0];
    %aliases= ();
    my @ret = ();
    my %linkage;
    my $userlinkage;
    $genprefix = $gen_prefix;
    $error = 0;

    print STDERR ('GetOptions $Revision: 2.11 $ ',
		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
		  "called from package \"$pkg\".\n",
		  "  (@ARGV)\n",
		  "  autoabbrev=$autoabbrev".
		  ",bundling=$bundling",
		  ",getopt_compat=$getopt_compat",
		  ",order=$order",
		  ",\n  ignorecase=$ignorecase",
		  ",passthrough=$passthrough",
		  ",genprefix=\"$genprefix\"",
		  ".\n")
	if $debug;

    $userlinkage = undef;
    if ( ref($optionlist[0]) and
	 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
	$userlinkage = shift (@optionlist);
	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
    }

    if ( $optionlist[0] =~ /^\W+$/ ) {
	$genprefix = shift (@optionlist);
	$genprefix =~ s/(\W)/\\$1/g;
	$genprefix = "[" . $genprefix . "]";
    }

    %opctl = ();
    %bopctl = ();
    while ( @optionlist > 0 ) {
	my $opt = shift (@optionlist);

	$opt = $' if $opt =~ /^($genprefix)+/;

	if ( $opt eq '<>' ) {
	    if ( (defined $userlinkage)
		&& !(@optionlist > 0 && ref($optionlist[0]))
		&& (exists $userlinkage->{$opt})
		&& ref($userlinkage->{$opt}) ) {
		unshift (@optionlist, $userlinkage->{$opt});
	    }
	    unless ( @optionlist > 0 
		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
		warn ("Option spec <> requires a reference to a subroutine\n");
		$error++;
		next;
	    }
	    $linkage{'<>'} = shift (@optionlist);
	    next;
	}

	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
	    warn ("Error in option spec: \"", $opt, "\"\n");
	    $error++;
	    next;
	}
	my ($o, $c, $a) = ($1, $2);
	$c = '' unless defined $c;

	if ( ! defined $o ) {
	    $opctl{$o = ''} = $c;
	}
	else {
	    my @o =  split (/\|/, $o);
	    my $linko = $o = $o[0];
	    $a = $o unless $o eq lc($o);
	    $o = lc ($o)
		if $ignorecase > 1 
		    || ($ignorecase
			&& ($bundling ? length($o) > 1  : 1));

	    foreach ( @o ) {
		if ( $bundling && length($_) == 1 ) {
		    $_ = lc ($_) if $ignorecase > 1;
		    if ( $c eq '!' ) {
			$opctl{"no$_"} = $c;
			warn ("Ignoring '!' modifier for short option $_\n");
			$c = '';
		    }
		    $opctl{$_} = $bopctl{$_} = $c;
		}
		else {
		    $_ = lc ($_) if $ignorecase;
		    if ( $c eq '!' ) {
			$opctl{"no$_"} = $c;
			$c = '';
		    }
		    $opctl{$_} = $c;
		}
		if ( defined $a ) {
		    $aliases{$_} = $a;
		}
		else {
		    $a = $_;
		}
	    }
	    $o = $linko;
	}

	if ( defined $userlinkage ) {
	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
		if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
		    print STDERR ("=> found userlinkage for \"$o\": ",
				  "$userlinkage->{$o}\n")
			if $debug;
		    unshift (@optionlist, $userlinkage->{$o});
		}
		else {
		    next;
		}
	    }
	}

	if ( @optionlist > 0 && ref($optionlist[0]) ) {
	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
		if $debug;
	    if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
		$linkage{$o} = shift (@optionlist);
	    }
	    elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
		$linkage{$o} = shift (@optionlist);
		$opctl{$o} .= '@'
		  if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
		$bopctl{$o} .= '@'
		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
	    }
	    elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
		$linkage{$o} = shift (@optionlist);
		$opctl{$o} .= '%'
		  if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
		$bopctl{$o} .= '%'
		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
	    }
	    else {
		warn ("Invalid option linkage for \"", $opt, "\"\n");
		$error++;
	    }
	}
	else {
	    my $ov = $o;
	    $ov =~ s/\W/_/g;
	    if ( $c =~ /@/ ) {
		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
	    }
	    elsif ( $c =~ /%/ ) {
		print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
	    }
	    else {
		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
	    }
	}
    }

    return 0 if $error;

    @opctl = sort(keys (%opctl)) if $autoabbrev;

    if ( $debug ) {
	my ($arrow, $k, $v);
	$arrow = "=> ";
	while ( ($k,$v) = each(%opctl) ) {
	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
	    $arrow = "   ";
	}
	$arrow = "=> ";
	while ( ($k,$v) = each(%bopctl) ) {
	    print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
	    $arrow = "   ";
	}
    }

    while ( @ARGV > 0 ) {

	$opt = shift (@ARGV);
	$arg = undef;
	$array = $hash = 0;
	print STDERR ("=> option \"", $opt, "\"\n") if $debug;

	if ( $opt eq $argend ) {
	    unshift (@ARGV, @ret) 
		if $order == $PERMUTE;
	    return ($error == 0);
	}

	my $tryopt = $opt;

	if ( &$find_option () ) {
	    
	    next unless defined $opt;

	    if ( defined $arg ) {
		$opt = $aliases{$opt} if defined $aliases{$opt};

		if ( defined $linkage{$opt} ) {
		    print STDERR ("=> ref(\$L{$opt}) -> ",
				  ref($linkage{$opt}), "\n") if $debug;

		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
			print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
			${$linkage{$opt}} = $arg;
		    }
		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
			    if $debug;
			push (@{$linkage{$opt}}, $arg);
		    }
		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
			    if $debug;
			$linkage{$opt}->{$key} = $arg;
		    }
		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
			print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
			    if $debug;
			&{$linkage{$opt}}($opt, $arg);
		    }
		    else {
			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
				      "\" in linkage\n");
			die ("Getopt::Long -- internal error!\n");
		    }
		}
		elsif ( $array ) {
		    if ( defined $userlinkage->{$opt} ) {
			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
			    if $debug;
			push (@{$userlinkage->{$opt}}, $arg);
		    }
		    else {
			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
			    if $debug;
			$userlinkage->{$opt} = [$arg];
		    }
		}
		elsif ( $hash ) {
		    if ( defined $userlinkage->{$opt} ) {
			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
			    if $debug;
			$userlinkage->{$opt}->{$key} = $arg;
		    }
		    else {
			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
			    if $debug;
			$userlinkage->{$opt} = {$key => $arg};
		    }
		}
		else {
		    print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
		    $userlinkage->{$opt} = $arg;
		}
	    }
	}

	elsif ( $order == $PERMUTE ) {
	    my $cb;
	    if ( (defined ($cb = $linkage{'<>'})) ) {
		&$cb($tryopt);
	    }
	    else {
		print STDERR ("=> saving \"$tryopt\" ",
			      "(not an option, may permute)\n") if $debug;
		push (@ret, $tryopt);
	    }
	    next;
	}

	else {
	    unshift (@ARGV, $tryopt);
	    return ($error == 0);
	}

    }

    if ( $order == $PERMUTE ) {
	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
	    if $debug && @ret > 0;
	unshift (@ARGV, @ret) if @ret > 0;
    }

    return ($error == 0);
}

sub config (@) {
    my (@options) = @_;
    my $opt;
    foreach $opt ( @options ) {
	my $try = lc ($opt);
	my $action = 1;
	if ( $try =~ /^no_?/ ) {
	    $action = 0;
	    $try = $';
	}
	if ( $try eq 'default' or $try eq 'defaults' ) {
	    &$config_defaults () if $action;
	}
	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
	    $autoabbrev = $action;
	}
	elsif ( $try eq 'getopt_compat' ) {
	    $getopt_compat = $action;
	}
	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
	    $ignorecase = $action;
	}
	elsif ( $try eq 'ignore_case_always' ) {
	    $ignorecase = $action ? 2 : 0;
	}
	elsif ( $try eq 'bundling' ) {
	    $bundling = $action;
	}
	elsif ( $try eq 'bundling_override' ) {
	    $bundling = $action ? 2 : 0;
	}
	elsif ( $try eq 'require_order' ) {
	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
	}
	elsif ( $try eq 'permute' ) {
	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
	}
	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
	    $passthrough = $action;
	}
	elsif ( $try eq 'debug' ) {
	    $debug = $action;
	}
	else {
	    $Carp::CarpLevel = 1;
	    Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
	}
    }
}

sub require_version {
    no strict;
    my ($self, $wanted) = @_;
    my $pkg = ref $self || $self;
    my $version = $ {"${pkg}::VERSION"} || "(undef)";

    $wanted .= '.0' unless $wanted =~ /\./;
    $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
    $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
    if ( $version < $wanted ) {
	$version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
	$wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
	$Carp::CarpLevel = 1;
	Carp::croak("$pkg $wanted required--this is only version $version")
    }
    $version;
}

$find_option = sub {

    return 0 unless $opt =~ /^$genprefix/;

    $opt = $';
    my ($starter) = $&;

    my $optarg = undef;
    my $rest = undef;

    if (($starter eq "--" || $getopt_compat)
	&& $opt =~ /^([^=]+)=/ ) {
	$opt = $1;
	$optarg = $';
	print STDERR ("=> option \"", $opt, 
		      "\", optarg = \"$optarg\"\n") if $debug;
    }


    my $tryopt = $opt;		# option to try
    my $optbl = \%opctl;	# table to look it up (long names)
    my $type;

    if ( $bundling && $starter eq '-' ) {
	$rest = substr ($tryopt, 1);
	$tryopt = substr ($tryopt, 0, 1);
	$tryopt = lc ($tryopt) if $ignorecase > 1;
	print STDERR ("=> $starter$tryopt unbundled from ",
		      "$starter$tryopt$rest\n") if $debug;
	$rest = undef unless $rest ne '';
	$optbl = \%bopctl;	# look it up in the short names table

	if ( $bundling == 2 and
	     defined ($type = $opctl{$tryopt.$rest}) ) {
	    print STDERR ("=> $starter$tryopt rebundled to ",
			  "$starter$tryopt$rest\n") if $debug;
	    $tryopt .= $rest;
	    undef $rest;
	}
    } 

    elsif ( $autoabbrev ) {
	$tryopt = $opt = lc ($opt) if $ignorecase;
	my $pat = quotemeta ($opt);
	my @hits = grep (/^$pat/, @opctl);
	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
		      "out of ", scalar(@opctl), "\n") if $debug;

	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
	    my %hit;
	    foreach ( @hits ) {
		$_ = $aliases{$_} if defined $aliases{$_};
		$hit{$_} = 1;
	    }
	    unless ( keys(%hit) == 1 ) {
		return 0 if $passthrough;
		print STDERR ("Option ", $opt, " is ambiguous (",
			      join(", ", @hits), ")\n");
		$error++;
		undef $opt;
		return 1;
	    }
	    @hits = keys(%hit);
	}

	if ( @hits == 1 && $hits[0] ne $opt ) {
	    $tryopt = $hits[0];
	    $tryopt = lc ($tryopt) if $ignorecase;
	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
		if $debug;
	}
    }

    elsif ( $ignorecase ) {
	$tryopt = lc ($opt);
    }

    $type = $optbl->{$tryopt} unless defined $type;
    unless  ( defined $type ) {
	return 0 if $passthrough;
	warn ("Unknown option: ", $opt, "\n");
	$error++;
	return 1;
    }
    $opt = $tryopt;
    print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;

    if ( $type eq '' || $type eq '!' ) {
	if ( defined $optarg ) {
	    return 0 if $passthrough;
	    print STDERR ("Option ", $opt, " does not take an argument\n");
	    $error++;
	    undef $opt;
	}
	elsif ( $type eq '' ) {
	    $arg = 1;		# supply explicit value
	}
	else {
	    substr ($opt, 0, 2) = ''; # strip NO prefix
	    $arg = 0;		# supply explicit value
	}
	unshift (@ARGV, $starter.$rest) if defined $rest;
	return 1;
    }

    my $mand;
    ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;

    if ( defined $optarg ? ($optarg eq '') 
	 : !(defined $rest || @ARGV > 0) ) {
	if ( $mand eq "=" ) {
	    return 0 if $passthrough;
	    print STDERR ("Option ", $opt, " requires an argument\n");
	    $error++;
	    undef $opt;
	}
	if ( $mand eq ":" ) {
	    $arg = $type eq "s" ? '' : 0;
	}
	return 1;
    }

    $arg = (defined $rest ? $rest
	    : (defined $optarg ? $optarg : shift (@ARGV)));

    $key = undef;
    if ($hash && defined $arg) {
	($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
    }

    if ( $type eq "s" ) {	# string
	return 1 if $mand eq "=";

	return 1 if defined $optarg || defined $rest;
	return 1 if $arg eq "-"; # ??

	if ($arg eq $argend ||
	    $arg =~ /^$genprefix.+/) {
	    unshift (@ARGV, $arg);
	    $arg = '';
	}
    }

    elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
	if ( $arg !~ /^-?[0-9]+$/ ) {
	    if ( defined $optarg || $mand eq "=" ) {
		if ( $passthrough ) {
		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
		      unless defined $optarg;
		    return 0;
		}
		print STDERR ("Value \"", $arg, "\" invalid for option ",
			      $opt, " (number expected)\n");
		$error++;
		undef $opt;
		unshift (@ARGV, $starter.$rest) if defined $rest;
	    }
	    else {
		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
		$arg = 0;
	    }
	}
    }

    elsif ( $type eq "f" ) { # real number, int is also ok
	if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
	    if ( defined $optarg || $mand eq "=" ) {
		if ( $passthrough ) {
		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
		      unless defined $optarg;
		    return 0;
		}
		print STDERR ("Value \"", $arg, "\" invalid for option ",
			      $opt, " (real number expected)\n");
		$error++;
		undef $opt;
		unshift (@ARGV, $starter.$rest) if defined $rest;
	    }
	    else {
		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
		$arg = 0.0;
	    }
	}
    }
    else {
	die ("GetOpt::Long internal error (Can't happen)\n");
    }
    return 1;
};

$config_defaults = sub {
    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
	$gen_prefix = "(--|-)";
	$autoabbrev = 0;		# no automatic abbrev of options
	$bundling = 0;			# no bundling of single letter switches
	$getopt_compat = 0;		# disallow '+' to start options
	$order = $REQUIRE_ORDER;
    }
    else {
	$gen_prefix = "(--|-|\\+)";
	$autoabbrev = 1;		# automatic abbrev of options
	$bundling = 0;			# bundling off by default
	$getopt_compat = 1;		# allow '+' to start options
	$order = $PERMUTE;
    }
    $debug = 0;			# for debugging
    $error = 0;			# error tally
    $ignorecase = 1;		# ignore case when matching options
    $passthrough = 0;		# leave unrecognized options alone
};

($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;

&$config_defaults ();

# ****************** END OF CODE LICENSED UNDER GNU GPL **********************

# TODO
#
# Quote mark/kram if it appears.
#	Update: This is not good because we only allow ONE substitution per
#		input line. Changing this requires a loop where mostly only
#		one process is done anyway.

# Global variables

# The I/O technique:
#
# We first read the old configuration file and build a template.  The
# template will contain everything of the config file and stubs for
# configurable entities. Writing the config file back is essentially
# a process of replacing the stubs with the new args, commenting out
# deleted fields, and adding new entries.
#
# An option will be provided to write the config file from scratch.  In
# this case, we'll replace the output template with our own version
# (adjusted to the match the number of devices, etc.).
#
# NOTE: To make this work correctly, we need a marker for the stubs. The
# marker is defined below, where the constants are defined.  Hopefully
# it is not used elsewhere in the XF86Config file.

$worst_code = 0;
undef @output_template;

#
# idea: check if mouse port is device, that all filenames exist etc.
#
$program_name = $0;
$case_sensitive = 0;	# 0 is false.

$re_mod = '';		# Modifier for Regular Expressions

# Constants

# The output_template will contain stubs for the field args. We have
# to mark the stubs at the beginning and at the end (it would be
# possible to mark only the beginning, but it's better not to be too
# intelligent). It should be safe to use the same mark for beginning
# ($mark) and for the end ($kram), but I'll distinguish them to make the
# parser more robust.

# TODO: Detect marker, so we can bail out or quote it.
#

$mark = '<MARK>';
$kram = '<KRAM>';

# We construct a section with section and optional seperator+subsection.
# FIXME: The $cf definition has to be changed manually if this is changed
# here.
$sect_sep = '_';
$ivar = 'XSPIT_';

# Data storage:
#
# Data is stored in a hash, so you can do the following:
#
# $cf{"Files"} = \%cf_files;
#
# The result is a reference to another hash, and the elements of this
# hash are again hashes, one for each field. This is scalable.
#
# You can access fields this way:
#
# $cf->{Files}->{FontPath}->{Arg}
#
# These hash keys are defined:
#	%$cf;				One key for each section.
#	%$cf->{Section}			One key for each field.
#	%$cf->{Section}->{Field}	'Type', 'Arg', 'RegEx'
#       $cf->{Section}->{Field}->{Type} is one of the following:
#	Flag		This means, the field is a flag without further data.
#	Array		This means, Arg is a reference to an array with entries.

# We have a special mechanism to allow lists of values to be created
# automatically. If there is a 'Count' element, the arguments of several
# occurences of the section will be stored in an array.  If a 'Reset'
# element is there, its content specifies anotehr section which counter
# will be reset to zero if the first section appears again. In this
# case, 'MetaCount' will be incremented.  (This strange mechanism cares
# about parents and childrens which can both appear multiple times, like
# the Screen+Display sections).

# FontPath
# Open questions:
# 	Are relative path names allowed, and if yes, relative to what
#	directory?
#         BR: I'd say no.  The X server's CWD is the same as that of the
#         process that spawned it.  While an X server spawned by xdm (and
#         thus ultimately by init) may behave predictably, users can and will
#         startx from anywhere.  Relative paths should be disallowed.
#       Is it allowed to end a directory without "/"?
#         BR: This shouldn't matter.
#       What about ":unscaled" and other qualifiers?
#         BR: We should definitely look for a colon.  It should either be
#         followed by the word "unscaled" in lowercase, and be preceded by
#         a valid absolute path (preferably matching the glob
#         /usr/X11R6/lib/X11/fonts/*), or it should be followed by a
#         numeric value (unsigned short), and preceded by a transaction
#         type and a hostname or IP.
#         Ideally we'd
#         only let dirs reserved for scalable fonts possess this modifier
#         (the misc font dir may have anything in it, including unscaled
#         fonts).
#       What is a hostname?
#         BR: We probably shouldn't bother checking for a resolvable
#         hostname or IP.  Or maybe it should be a warning.  But to do that
#         probably means inlining more perl.  :(

$cf={
	Files => {
		FontPath => {
			$ivar.'Required', 'Warning',
			Type  => 'Array',
			RegEx => '^"(((/.*?/?)(:unscaled)?|(\w+/[\w\d.-]*:\d+)),)*((/.*?/?)(:unscaled)?|(\w+/[\w\d.-]*:\d+))"$'},
		RgbPath => {
			$ivar.'Required', 'Warning',
			Type  => 'Scalar',
			RegEx => '^"/.*[^/]"$'},
		ModulePath => {
			Type  => 'Array',
			RegEx => '^"(/.*?,)*(/.*?)"$'}
	},
	Module => {
		Load => {
			Type  => 'Array',
			RegEx => '^".*?"$'}
	},
	ServerFlags => {
		NoTrapSignals => {
			Type  => 'Flag',
			RegEx => '^$'},
		DontZap => {
			Type  => 'Flag',
			RegEx => '^$'},
		DontZoom => {
			Type  => 'Flag',
			RegEx => '^$'},
		AllowNonLocalXvidtune => {
			Type  => 'Flag',
			RegEx => '^$'},
		DisableVidModeExtension => {
			Type  => 'Flag',
			RegEx => '^$'},
		AllowNonLocalModInDev => {
			Type  => 'Flag',
			RegEx => '^$'},
		DisableModInDev => {
			Type  => 'Flag',
			RegEx => '^$'},
		AllowMouseOpenFail => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	Keyboard => {
		Protocol => {
			Type  => 'Scalar',
			RegEx => '^"(Standard|Xqueue)"$'},
		AutoRepeat => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+$'},
		ServerNumLock => {
			Type  => 'Flag',
			RegEx => '^$'},
		LeftAlt => {
			Type  => 'Scalar',
			RegEx => '^(Meta|Compose|ModeShift|ModeLock|ScrollLock|Control)$'},
		RightAlt => {
			Type  => 'Scalar',
			RegEx => '^(Meta|Compose|ModeShift|ModeLock|ScrollLock|Control)$'},
		AltGr => {
			Type  => 'Scalar',
			RegEx => '^(Meta|Compose|ModeShift|ModeLock|ScrollLock|Control)$'},
		ScrollLock => {
			Type  => 'Scalar',
			RegEx => '^(Meta|Compose|ModeShift|ModeLock|ScrollLock|Control)$'},
		RightCtl => {
			Type  => 'Scalar',
			RegEx => '^(Meta|Compose|ModeShift|ModeLock|ScrollLock|Control)$'},
		XLeds => {
			Type  => 'Scalar',
			RegEx => '^((1|2|3)\s+)*(1|2|3)$'},
		VTSysReq => {
			Type  => 'Flag',
			RegEx => '^$'},
		VTInit => {
			Type  => 'Scalar',
			RegEx => '^"[^"]*"$'},
		XkbDisable => {
			Type  => 'Flag',
			RegEx => '^$'},
		XkbRules => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbModel => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbLayout => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbVariant => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbOptions => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbKeymap => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbKeycodes => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbTypes => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbCompat => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbSymbols => {
			Type  => 'Scalar',
			RegEx => '^".*"$'},
		XkbGeometry => {
			Type  => 'Scalar',
			RegEx => '^".*"$'}
	},
	Pointer => {
		Protocol => {
			$ivar.'Required', 'Warning',
			Type  => 'Scalar',
			RegEx => '^"(Auto|BusMouse|GlidePoint|GlidePointPS/2|IntelliMouse|IMPS/2|Logitech|Microsoft|MMHitTab|MMSeries|MouseMan|MouseManPlusPS/2|MouseSystems|NetMousePS/2|NetScrollPS/2|OSMouse|PS/2|SysMouse|ThinkingMouse|ThinkingMousePS/2|Xqueue)"$'},
		Device => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		Port => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		BaudRate => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		# Buttons should be large enough to accomodate any existing
		# ZAxisMapping.  The server assumes Buttons=3 if it is not
		# told otherwise.
		Buttons  => {
			Type  => 'Scalar',
			RegEx => '^\d$'},	
		Emulate3Buttons => {
			Type  => 'Flag',
			RegEx => '^$'},
		Emulate3Timeout => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ChordMiddle => {
			Type  => 'Flag',
			RegEx => '^$'},
		SampleRate => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Resolution => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ClearDTR => {
			Type  => 'Flag',
			RegEx => '^$'},
		ClearRTS => {
			Type  => 'Flag',
			RegEx => '^$'},
		ZAxisMapping => {
			Type  => 'Scalar',
			RegEx => '^(X|Y|\d\s+\d)$'}
	},
	Monitor => {
		Count => -1,		# This implies that we use lists in all cases
		Reset => 'Monitor'.$sect_sep.'Mode',
 		Identifier => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		VendorName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		ModelName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		HorizSync => {
			Type  => 'Scalar',
			RegEx => '^(\d+(.\d+)?(\s*-\s*\d+(.\d)?)?\s*,\s*)*\d+(.\d+)?(\s*-\s*\d+(.\d+)?)?(\s*(Hz|MHz))?$'},
		VertRefresh => {
			Type  => 'Scalar',
			RegEx => '^(\d+(.\d+)?(\s*-\s*\d+(.\d)?)?\s*,\s*)*\d+(.\d+)?(\s*-\s*\d+(.\d+)?)?(\s*(kHz|MHz))?$'},
		Gamma => {
			Type  => 'Scalar',
			RegEx => '^(\d+|\d*.\d+)((\d+|\d*.\d+){2})?$'},
		Modeline => {
			Type  => 'Array',
			RegEx => '^"[^"]+"\s+\d+(.\d+)?(\s+\d+){8}(\s+([-+]HSync|[-+]VSync|Composite(\s+[+-]CSync)?|Interlace|DoubleScan|HSkew\s+\d+))*$'},
	},
	'Monitor'.$sect_sep.'Mode', {
		Count => -1,
		MetaCount => -1,
		$ivar.'Name' , {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^.*$'},
		DotClock => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^\d+(.\d+)?$'},
		HTimings => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^\d+(\s+\d+){3}$'},
		VTimings => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^\d+(\s+\d+){3}$'},
		Flags => {
			Type  => 'Scalar',
			RegEx => '^"([-+]HSync|[-+]VSync|Composite(\s+[+-]CSync)?|Interlace|DoubleScan)"(\s+"([-+]HSync|[-+]VSync|Composite(\s+[+-]CSync)?|Interlace|DoubleScan)")*$'},
		HSkew => {
			Type  => 'Scalar',
			RegEx => '^\d+$'}
	},
	Device => {
		Count => -1,
		Identifier => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		VendorName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		BoardName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Chipset => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
# Accel cards have:
# (s3_(generic|virge)|mmio_928|newmio|mach(8|32|64)|viper(vlb|pci)|orchidp9000|agx-01(0|4|5|6)|xga-(1|2)|et4000w32(i_rev_(b|c)|p_rev_(a|b|c|d))?|et6000|i128|tga|ibm8514)

                ChipRev => {
                        Type  => 'Scalar',
                        RegEx => '^\d+(.\d+)?$'},
		Ramdac => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},

# Accel cards:
# (normal|att20c(408|498|490|505)|att22c498|sc15025|sc1148(2|5)|bt485|ibm_rgb5(14|24|25|26|28)|stg170(0|3)|s3gendac|s3_sdac|ics53(00|41|42)|ti30(20|25|26|30)|bt48(1|2)|herc_(dual|small)_dac|ati688(60|75)|stg1702|ch8398|tlc34075)

		DacSpeed => {
			Type  => 'Scalar',
			RegEx => '^\d+(.\d+)?$'},
		Clocks => {
			Type  => 'Array',
			RegEx => '^\d+(.\d+)?(\s+\d+(.\d+)?)*$'},
		ClockChip => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
# Accel cards:
# (icd2061a|dcs2834|ics(5341|9161a|2595|5300|5342)|stg1703|sc11412|s3gendac|s3_sdac|ti30(25|26|30)|ch839(1|8)|att20c4(08|09|99)|ibm_rgb5xx|ati18818|et6000)

		ClockProg => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"(\s+\d+(.\d+)?)?$'},
		Option => {
			Type  => 'Array',
			RegEx => '^"[^"]+"$'},

# Accel cards:
# (no(memaccess|accel|linear|_bios_clocks|_program_clocks)|vram_(128|256)|(no_)?ti3020_curs|sw_cursor|dac_(8|6)_bit|sync_on_green|power_saver|intel_gx|ast_mach32|spea_mercury|stb_pegasus|number_nine|diamond|elsa_w(1000(pro|isa)|2000pro)|pci_hack|s3_964_bt485_vclk|genoa|stb|hercules|(slow|fast)_vram|slow_dram(_refresh)?|pci_burst_o(n|ff)|w32_interleave_o(n|ff)|(no_)?block_write|clkdiv2)

		VideoRam => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BIOSBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		MemBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{8}$'}, # 8 for accel cards
		IOBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		DACBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		POSBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		COPBase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		VGABase => {
			Type  => 'Scalar',
			RegEx => '^0x[a-fA-F0-9]{5}$'},
		Instance => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		SpeedUp => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		S3MNAdjust => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+$'},
		S3MClk => {
			Type  => 'Scalar',
			RegEx => '^\d+(.\d+)?$'},
		S3RefClk => {
			Type  => 'Scalar',
			RegEx => '^\d+(.\d+)?$'}
	},
	Screen => {
		Count => -1,
		Reset => 'Screen'.$sect_sep.'Display',
		Driver => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^"(Accel|FBDev|Mono|SVGA|VGA2|VGA16)"$'},
		Device => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Monitor => {
			$ivar.'Required', 'Error',
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		DefaultColorDepth => {
			Type  => 'Scalar',
			RegEx => '^(1|4|8|15|16|24|32)$'},
		ScreenNo => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BlankTime => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		StandByTime => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		SuspendTime => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		OffTime => {
			Type  => 'Scalar',
			RegEx => '^\d+$'}
	},
	'Screen'.$sect_sep.'Display', {
		Count => -1,
		MetaCount => -1,
		Depth => {
			Type  => 'Scalar',
			RegEx => '^(1|4|8|15|16|24|32)$'},
		Weight => {
			Type  => 'Scalar',
			RegEx => '^\d\d\d$'},
		Virtual => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+$'},
		ViewPort => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+$'},
		Modes => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"(\s+"[^"]+")*$'},
		InvertVCLK => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"\s+(0|1)$'},
		EarlySC => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"\s+(0|1)$'},
		BlankDelay => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"\s+[0-7]\s+[0-7]$'},
		Visual => {
			Type  => 'Scalar',
			RegEx => '^"(StaticGray|GrayScale|StaticColor|PseudoColor|TrueColor|DirectColor)"$'},
		Option => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Black => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+\s+\d+$'},
		White => {
			Type  => 'Scalar',
			RegEx => '^\d+\s+\d+\s+\d+$'}
	},
	XInput => {},
	'XInput'.$sect_sep.'Joystick', {
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		TimeOut => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MaximumXPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MinimumXPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MaximumYPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MinimumYPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		CenterX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		CenterY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Delta => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	'XInput'.$sect_sep.'WacomStylus', {
		Count => -1,
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Suppress => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Mode => {
			Type  => 'Scalar',
			RegEx => '^(Relative|Absolute)$'},
		TiltMode => {
			Type => 'Flag',
			RegEx => '^$'},
		HistorySize => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'},
		TopX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		TopY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		KeepShape => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	'XInput'.$sect_sep.'WacomEraser', {
		Count => -1,
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Suppress => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Mode => {
			Type  => 'Scalar',
			RegEx => '^(Relative|Absolute)$'},
		TiltMode => {
			Type  => 'Flag',
			RegEx => '^$'},
		HistorySize => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'},
		TopX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		TopY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		KeepShape => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	'XInput'.$sect_sep.'WacomCursor', {
		Count => -1,
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Suppress => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Mode => {
			Type  => 'Scalar',
			RegEx => '^(Relative|Absolute)$'},
		TiltMode => {
			Type  => 'Flag',
			RegEx => '^$'},
		HistorySize => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'},
		TopX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		TopY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomX => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		BottomY => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		KeepShape => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	'XInput'.$sect_sep.'Elographics', {
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		MaximumXPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MinimumXPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MaximumYPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		MinimumYPosition => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ScreenNo => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		UntouchDelay => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ReportDelay => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'}
	},
	'XInput'.$sect_sep.'SummaSketch', {
		Port  => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		Mode => {
			Type  => 'Scalar',
			RegEx => '^(Relative|Absolute)$'},
		Cursor => {
			Type  => 'Scalar',
			RegEx => '^(Stylus|Puck)$'},
		Increment => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'},
		HistorySize => {
			Type  => 'Scalar',
			RegEx => '^\d+$'}
	},
	'XInput'.$sect_sep.'Mouse', {
		Protocol => {
			Type  => 'Scalar',
			RegEx => '^"(Auto|BusMouse|GlidePoint|GlidePointPS/2|IntelliMouse|IMPS/2|Logitech|Microsoft|MMHitTab|MMSeries|MouseMan|MouseManPlusPS/2|MouseSystems|NetMousePS/2|NetScrollPS/2|OSMouse|PS/2|SysMouse|ThinkingMouse|ThinkingMousePS/2|Xqueue)"$'},
		Device => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		Port => {
			Type  => 'Scalar',
			RegEx => '^"/[\w\d/]*[\w\d]+"$'},
		BaudRate => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		# Buttons should be large enough to accomodate any existing
		# ZAxisMapping.  The server assumes Buttons=3 if it is not
		# told otherwise.
		Buttons  => {
			Type  => 'Scalar',
			RegEx => '^(2|3|4)$'},	# Changes also to ZAxisMapping!
		Emulate3Buttons => {
			Type  => 'Flag',
			RegEx => '^$'},
	Emulate3Timeout => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ChordMiddle => {
			Type  => 'Flag',
			RegEx => '^$'},
		SampleRate => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		Resolution => {
			Type  => 'Scalar',
			RegEx => '^\d+$'},
		ClearDTR => {
			Type  => 'Flag',
			RegEx => '^$'},
		ClearRTS => {
			Type  => 'Flag',
			RegEx => '^$'},
		ZAxisMapping => {
			Type  => 'Scalar',
			RegEx => '^(X|Y|(2|3|4){2})$'},
		DeviceName => {
			Type  => 'Scalar',
			RegEx => '^"[^"]+"$'},
		AlwaysCore => {
			Type  => 'Flag',
			RegEx => '^$'}
	}
};

$valid_Section = '^"('.join('|', keys (%$cf)).')"$';

# Messages
#
# All messages are listed here and allow up to three parameters. Use the
# routine my_abort, my_error et al. to access them.
#
# The idea is that the script can be easily translated to other locales
# this way, without much overhead (all languages can be included in this
# file, really).
$info_usage = "Usage: $program_name [OPTION] ... FILE\nTry `$program_name --help' for more information.\n";
$info_help = <<"EOF";
Usage: $program_name [OPTION] ... FILE
Parse an XF86Config file for errors.

  -h, --help        display this help and exit
  -q, --quiet       do not output anything
  -v, --verbose     act verbose

  -e, --error       check for errors in FILE (default)
      --noerror     do not check for errors in FILE
  -w, --warning     check for warnings in FILE (default)
      --nowarning   do not check for warnings in FILE
  -d, --advisory    check for advisories in FILE
      --noadvisory  do not check for advisories in FILE (default)
      --all         a shortcut for -e -w -d

Report bugs to <branden\@debian.org>.
EOF

$imp_parser_error = "Impossible parser error.";
$imp_err_msg_err = "Impossible error while building error message."; 
$imp_marker_conflict = "Internal marker ($mark, $kram) appear in the file, output may be incorrect.";

$inv_no_section = "_XXX_ appears outside of any section.";
$inv_arg = "Argument _YYY_ is invalid for field _XXX_.";
$inv_missing_arg = "No argument for field _XXX_.";
$inv_field = "Unknown field _XXX_ in section _YYY_.";
$inv_pointer_device_and_port = "Fields Device and Port (line _XXX_) in section Pointer conflict.";
$inv_pointer_no_device_or_port = "Section Pointer does contain neither Device nor Port.";
$inv_missing_field = "Field _YYY_ in section _XXX_ is not set.";
$inv_default_color_depth = "DefaultColorDepth _XXX_ in Screen _YYY_ is invalid (must be one of _ZZZ_).";

$warn_double_flag = "Flag _YYY_ occurs twice in section _XXX_.";
$warn_double_scalar = "Field _YYY_ occurs twice in section _XXX_.";
$warn_file_no_dir = "Entry _YYY_ in _XXX_ is not a directory.";
$warn_missing_field = "Field _YYY_ in section _XXX_ is not set.";
$warn_pointer_device_and_port = "Fields Device and Port (line _XXX_) in section Pointer are redundant.";
$warn_pointerdev_not_exists = "_XXX_ does not exist.";
$warn_pointerdev_not_a_chrdevice = "_XXX_ is not a character device or FIFO file name.";
$warn_pointer_mousesystems = "_XXX_ set in section Pointer, but protocol is not MouseSystems.";
$warn_unusual_videoram = "VideoRam in section Device _XXX_ is not multiple of 64.";

$adv_pointer_emulatethree = "Emulate3Buttons set in section Pointer, but _XXX_ pointer buttons specified.";
$adv_pointer_timeout_wo_emulatethree = "Emulate3Timeout set, but Emulate3Buttons is not.";
$adv_wrong_case = "_XXX_ should be spelled _YYY_.";

$fail_openread = "Couldn't open file _XXX_ for reading.";

sub my_error {
	my ($msg, $line, @stubs) = @_;
	my ($sline) = '';
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_XXX_/ && ($stubs[0] eq ''));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_YYY_/ && ($stubs[1] eq ''));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_ZZZ_/ && ($stubs[2] eq ''));
	if ($opt_error) {
		$sline = "$line:" if $line != -1;
		$msg =~ s/_XXX_/$stubs[0]/;
		$msg =~ s/_YYY_/$stubs[1]/;
		$msg =~ s/_ZZZ_/$stubs[2]/;
		print STDERR "$program_name:E:$sline $msg\n" if (!$opt_quiet);
		$worst_code=3;
	}
}

sub my_warn {
	my ($msg, $line, @stubs) = @_;
	my ($sline) = '';
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_XXX_/ && ($stubs[0] eq ""));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_YYY_/ && ($stubs[1] eq ""));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_ZZZ_/ && ($stubs[2] eq ""));
	if ($opt_warning) {
		$sline = "$line:" if $line != -1;
		$msg =~ s/_XXX_/$stubs[0]/;
		$msg =~ s/_YYY_/$stubs[1]/;
		$msg =~ s/_ZZZ_/$stubs[2]/;
		print STDERR "$program_name:W:$sline $msg\n" if (!$opt_quiet);
		$worst_code = 2 if ($worst_code < 2);
	}
}

sub my_advisory {
	my ($msg, $line, @stubs) = @_;
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_XXX_/ && ($stubs[0] eq ""));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_YYY_/ && ($stubs[1] eq ""));
	my_abort($imp_err_msg_err, $line) if ($msg =~ /_ZZZ_/ && ($stubs[2] eq ""));
	if ($opt_advisory) {
		$sline = "$line:" if $line != -1;
		$msg =~ s/_XXX_/$stubs[0]/;
		$msg =~ s/_YYY_/$stubs[1]/;
		$msg =~ s/_ZZZ_/$stubs[2]/;
		print STDERR "$program_name:A:$sline $msg\n" if (!$opt_quiet);
		$worst_code = 1 if ($worst_code == 0);
	}
}

sub my_fail {
	my ($msg, @stubs) = @_;
	my_abort($imp_err_msg_err, -1) if ($msg =~ /_XXX_/ && ($stubs[0] eq ""));
	my_abort($imp_err_msg_err, -1) if ($msg =~ /_YYY_/ && ($stubs[1] eq ""));
	my_abort($imp_err_msg_err, -1) if ($msg =~ /_ZZZ_/ && ($stubs[2] eq ""));
	$msg =~ s/_XXX_/$stubs[0]/;
	$msg =~ s/_YYY_/$stubs[1]/;
	$msg =~ s/_ZZZ_/$stubs[2]/;
	print STDERR "$program_name:F: $msg\n" if (!$opt_quiet);
	exit 1;
}

sub my_abort {
	die "$program_name:D:$_[1]: $_[0]\nPlease contact the maintainer of this program.\nStopped";
}


# cf_add: adds a $f(ield) in a $s(ection) withj $a(rgument) and
#         replaces it in the $t(emplate) [source file line $l]
sub cf_add {
    my($l, $s, $f, $a, $t) = @_;
    my $replace='';
    my $with;
    my $r;
    my $line;

    $with='$cf->{'.$s.'}->{'.$f.'}->{Arg}';    # We'll use it as a symbolic reference. See 'man perlref'.

    if (exists $cf->{$s}->{MetaCount}) {
	$with.='['."$cf->{$s}->{MetaCount}".']['."$cf->{$s}->{Count}".']';
	$r=\$cf->{$s}->{$f}->{Arg}[$cf->{$s}->{MetaCount}][$cf->{$s}->{Count}];
	$line=\$cf->{$s}->{$f}->{Line}[$cf->{$s}->{MetaCount}][$cf->{$s}->{Count}];
    } elsif (exists $cf->{$s}->{Count}) {
	$with.='['."$cf->{$s}->{Count}".']';
	$r=\$cf->{$s}->{$f}->{Arg}[$cf->{$s}->{Count}];
	$line=\$cf->{$s}->{$f}->{Line}[$cf->{$s}->{Count}];
    } else {
	$r=\$cf->{$s}->{$f}->{Arg};
        $line=\$cf->{$s}->{$f}->{Line};
    }

    if ($cf->{$s}->{$f}->{Type} eq 'Array') {
	push @$$r, $a;
	$replace=$a;
	$with=$mark.$with.'['."$#{$$r}".']'.$kram.$mark.$a.$kram;
	push @$$line, $l;
    } elsif ($cf->{$s}->{$f}->{Type} eq 'Flag') {
	if ($$r ne '') {
	    my_warn($warn_double_flag, $l, $s, $f);
	}
	$$r=$f;
	$replace=$f;
	$with=$mark.$with.$kram.$mark.$f.$kram;
	$$line=$l;
    } elsif ($cf->{$s}->{$f}->{Type} eq 'Scalar') {
	if ($$r ne '') {
	    my_warn($warn_double_scalar, $l, $s, $f);
	}
	$$r=$a;
	$replace=$a;
	$with=$mark.$with.$kram.$mark.$a.$kram;
	$$line=$l;
    } else {
	my_abort($imp_parser_error, $l);
    }
    $t =~ s/$replace/$with/;
    return $t;
}

# read_conffile (STREAM $stream)
#
# Reads the config file from the ready-to-read input stream STREAM.
# Stores the configuration in $cf and checks the syntax.
#
sub read_conffile {
    my $stream = shift @_;
    my $section="";		# Current section we're in.
    my $template="";		# Current line of the template.
    my $field="";		# Current field.
    my $arg="";			# Current arg of field.
    my $temp;			# temporary variable for loops

    if ($opt_verbose) { print STDERR "Reading file.\n"; }

    while (<$stream>) {
	my_warn($imp_marker_conflict, $.) if /$mark/ || /$kram/;
        # The regular expression splits the current input line in three
        # parts: the field, the arg and an optional comment.  The
        # difficulty is the arg of the field, because we have to catch
        # "..." groups.
	/^\s*([^\s#"]+)?\s*(([^#"]|"[^"]*")+?)?\s*(#.*)?$/;
	$field=$1;
	$arg=$2;
	$template=$_;

	if($field eq '' && $arg ne '') {	# Should never happen.
	    my_abort($imp_parser_error, $.);
	}


	if ($field ne '') {			# We only have something to do if there is a $field.
	    if ($section eq '') {		# Let's say we are not inside a section.
		if ($field !~ /^Section$/i) {	# And we are not opening a new section.
		    my_error ($inv_no_section, $., $field);	# Then we are in trouble.
		} else {
		    if ($arg eq '') {		# Section does need an argument.
			my_error ($inv_missing_arg, $., $field);
		    } else {
			$section=$arg;
			$section =~ s/^"([^"]*)"$/$1/;
			if (!exists $cf->{$section}) {
			    foreach $temp (keys %$cf) {
				if ($temp =~ /^$section$/i) {
				    my_advisory($adv_wrong_case, $., $section, $temp);
				    $section = $temp;
				    last;
				}
			    }
			}
			my_error($inv_arg, $., $field, $arg) if (!exists $cf->{$section});
			if (exists $cf->{$section}->{Count}) {
			    $cf->{$section}->{Count}++;
			}
			if (exists $cf->{$section}->{Reset}) {
			    $cf->{$cf->{$section}->{Reset}}->{Count} = -1;
			    $cf->{$cf->{$section}->{Reset}}->{MetaCount}++;
			}
		    }
		}
	    } elsif ($field =~ /^EndSection$/i) {	# Now comes field handling common to all sections.
		my_error($inv_arg, $., $field, $arg) if $arg ne '';
		$section = '';
	    } elsif ($field =~ /^SubSection$/i){
		if ($arg eq '') {
		    my_error ($inv_missing_arg, $., $field);
		} else {
		    $arg =~ s/^"([^"]*)"$/$1/;
		    $section .= $sect_sep.$arg;
		    if (!exists $cf->{$section}) {
			foreach $temp (keys %$cf) {
			    if ($temp =~ /^$section$/i) {
				$section = $temp;
				$temp =~ s/^.*$sect_sep//;
				my_advisory($adv_wrong_case, $., $arg, $temp);
				last;
			    }
			}
		    }
		    my_error($inv_arg, $., $field, $arg) if (!exists $cf->{$section});
		    if (exists $cf->{$section}->{Count}) {
			$cf->{$section}->{Count}++;
		    }
		}
	    } elsif ($field =~ /^EndSubSection$/i) {
		my_error($inv_arg, $., $field, $arg) if $arg ne '';
		$section =~ s/$sect_sep.*$//;
	    } elsif ($field =~ /^Mode$/i && $section =~ /^Monitor$/) {
		if ($arg eq '') {
		    my_error ($inv_missing_arg, $., $field);
		} else {
		    $arg =~ s/^"([^"]*)"$/$1/;
		    $section .= $sect_sep.'Mode';
		    if (!exists $cf->{$section}) {
			foreach $temp (keys %$cf) {
			    if ($temp =~ /^$section$/i) {
				$section = $temp;
				$temp =~ s/^.*$sect_sep//;
				my_advisory($adv_wrong_case, $., $arg, $temp);
				last;
			    }
			}
		    }
		    my_error($inv_arg, $., $field, $arg) if (!exists $cf->{$section});
		    if (exists $cf->{$section}->{Count}) {
			$cf->{$section}->{Count}++;
		    }
		    $template = cf_add($., $section, $ivar.'Name', $arg, $template);
		}
	    } elsif ($field =~ /^EndMode$/i) {
		my_error($inv_arg, $., $field, $arg) if $arg ne '';
		$section =~ s/$sect_sep.*$//;
	    } else {
		if (!exists($cf->{$section}->{$field})) {
		    foreach $temp (keys %{$cf->{$section}}) {
			if ($temp =~ /^$field$/i) {
			    my_advisory($adv_wrong_case, $., $field, $temp);
			    $field = $temp;
			    last;
			}
		    }
		}
		if (!exists($cf->{$section}->{$field})) {
		    my_error($inv_field, $., $field, $section);
		} else {
		    if ($arg !~ /$cf->{$section}->{$field}->{RegEx}/i) {
			if ($arg eq '') {
			    my_error($inv_missing_arg, $., $field);
			} else {
			    my_error($inv_arg, $., $field, $arg);
			}
		    } # else { # Activate if you don't want to store values on error.
		    $template = cf_add($., $section, $field, $arg, $template);
		}
	    }
	}
	push @output_template, $template;
    }
}

sub check_err_and_warn {
    my $i=0;
    my ($a,$c,$d,$m,@a);

    if ($opt_verbose) { print STDERR "Checking file for warning and errors.\n"; }

    # Generic Checks

    # Probably implement a sub function to do something with all keys?

    foreach $a (keys %$cf) {
	foreach $c (keys %{$cf->{$a}}) {
	    if (exists $cf->{$a}->{Count}) {
		if (exists $cf->{$a}->{MetaCount}) {
		    for ($m = 0; $m <= $cf->{$a}->{MetaCount}; $m++) {
			for ($n = 0; $n <= $cf->{$a}->{Count}; $n++) {
			    if (!defined $cf->{$a}->{$c}->{Arg}[$m][$n]) {
				if ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Warning") {
				    my_warn($warn_missing_field, $cf->{$a}{$c}{Line}[$m][$n], $a,$c);
				} elsif ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Error") {
				    my_error($inv_missing_field, $cf->{$a}{$c}{Line}[$m][$n], $a,$c);
				}
			    }
			}
		    }
		} else {
		    for ($m = 0; $m <= $cf->{$a}->{Count}; $m++) {
			if (!defined $cf->{$a}->{$c}->{Arg}[$m]) {
			    if ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Warning") {
				my_warn($warn_missing_field, $cf->{$a}{$c}{Line}[$m], $a,$c);
			    } elsif ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Error") {
				my_error($inv_missing_field, $cf->{$a}{$c}{Line}[$m], $a,$c);
			    }
			}
		    }
		}
	    } else {
		if (!exists $cf->{$a}->{$c}->{Arg}) {
		    if ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Warning") {
			my_warn($warn_missing_field, $cf->{$a}{$c}{Line}, $a,$c);
		    } elsif ($cf->{$a}->{$c}->{$ivar.'Required'} eq "Error") {
			my_error($inv_missing_field, $cf->{$a}{$c}{Line}, $a,$c);
		    }
		}
	    }
	}
    }

    foreach $c ('FontPath','ModulePath') {
	if (exists $cf->{Files}->{$c}->{Arg}) {
	    for ($i=0; $i <= $#{$cf->{Files}->{$c}->{Arg}}; $i++) {
		$a = $cf->{Files}->{$c}->{Arg}[$i];
		$a =~ s/(^"|"$)//g;
		@a = split(',', $a);
		while ($a=shift @a) {
		    if ($a !~ m!\w+/[\w\d.]+:\d+!) {
			$a =~ s/:unscaled//g;
			if (!-d $a) {
			    my_warn($warn_file_no_dir, $cf->{Files}{$c}{Line}[$i], $c, $a);
			}
		    }
		}
	    }
	}
    }

    # Pointer
    #	Device & Port

    if ((exists $cf->{Pointer}->{Device}->{Arg}) && (exists $cf->{Pointer}->{Port}->{Arg})) {
	if ($cf->{Pointer}->{Device}->{Arg} ne $cf->{Pointer}->{Port}->{Arg}) {
	    my_error($inv_pointer_device_and_port, $cf->{Pointer}{Device}{Line}, $cf->{Pointer}{Port}{Line});
	} else {
	    my_warn($warn_pointer_device_and_port, $cf->{Pointer}{Device}{Line}, $cf->{Pointer}{Port}{Line});
	}
    } elsif ((!exists $cf->{Pointer}->{Device}->{Arg}) && (!exists $cf->{Pointer}->{Port}->{Arg})) {
	my_error($inv_pointer_no_device_or_port, -1);
    } else {
	my $device = $cf->{Pointer}->{Device}->{Arg}.$cf->{Pointer}->{Port}->{Arg};
	$device =~ s/"//g;
	if (!(-e $device)) {
	    my_warn($warn_pointerdev_not_exists, $cf->{Pointer}{Device}{Line} + $cf->{Pointer}{Port}{Line},$device);
	} elsif (!(-c $device) && !(-p $device)) {
	    my_warn($warn_pointerdev_not_a_chrdevice, $cf->{Pointer}{Device}{Line} + $cf->{Pointer}->{Port}->{Line}, $device);
	}
    }

    # Pointer
    #	Emulate3Buttons and Emulate3Timeout

    if ((exists $cf->{Pointer}->{Emulate3Buttons}->{Arg}) && ($cf->{Pointer}->{Buttons}->{Arg} ne '2')) {
	my $buttons = (exists $cf->{Pointer}->{Buttons}->{Arg}) ? $cf->{Pointer}->{Buttons}->{Arg} : '3';
	my_advisory($adv_pointer_emulatethree, $cf->{Pointer}{Emulate3Buttons}{Line}, $buttons);
    }

    if ((exists $cf->{Pointer}->{Emulate3Timeout}->{Arg}) && (!exists $cf->{Pointer}->{Emulate3Buttons}->{Arg})) {
	my_advisory($adv_pointer_timeout_wo_emulatethree, $cf->{Pointer}{Emulate3Timeout}{Line});
    }

    # Pointer
    #	ClearRTS, ClearDTR and MouseSystems

    if ((exists $cf->{Pointer}->{ClearRTS}->{Arg}) && ($cf->{Pointer}->{Protocol}->{Arg} ne '"MouseSystems"')) {
	my_warn($warn_pointer_mousesystems, $cf->{Pointer}{ClearRTS}{Line}, 'ClearRTS');
    }
    if ((exists $cf->{Pointer}->{ClearDTR}->{Arg}) && ($cf->{Pointer}->{Protocol}->{Arg} ne '"MouseSystems"')) {
	my_warn($warn_pointer_mousesystems, $cf->{Pointer}{ClearDTR}{Line}, 'ClearDTR');
    }

    # Device
    #	VideoRam

    $a=$#{$cf->{Device}{VideoRam}{Arg}};
    while ($a >= 0) {
	if (($cf->{Device}{VideoRam}{Arg}[$a--] % 64 ) != 0) {
	    my_warn($warn_unusual_videoram, $cf->{Device}{VideoRam}{Line}[$a+1], $cf->{Device}{Identifier}{Arg}[$a+1]);
	}
    }

    for ($c=0; $c <= $#{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}}; $c++) {
	if ($#{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c]} > 1) {
	    if (join(',',@{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c]}) !~ m/\b$cf->{Screen}{DefaultColorDepth}{Arg}[$c]\b/) {
		my_error($inv_default_color_depth, $cf->{Screen}{DefaultColorDepth}{Line}[$c], $cf->{Screen}{DefaultColorDepth}{Arg}[$c], $cf->{Screen}{Driver}{Arg}[$c], join (',',@{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c]}));
	    }
	    for ($d=0; $d <= ($#{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c]}); $d++) {
		if (!defined $cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c][$d]) {
		    my_error($inv_missing_field, -1, 'Screen '.$cf->{Screen}{Driver}{Arg}[$c].'/Display', 'Depth');
		} else {
		    for ($a=$d+1; $a <= $#{$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c]}; $a++) {
			if ($cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c][$d] == $cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c][$a]) {
			    my_error($warn_double_scalar, $cf->{'Screen'.$sect_sep.'Display'}{Depth}{Line}[$c][$a], 'Section/Display', 'Depth '.$cf->{'Screen'.$sect_sep.'Display'}{Depth}{Arg}[$c][$a]);
			}
		    }
		}
	    }
	}
    }
}	

sub write_conffile {
    my $stream = shift @_;
    my $r; # symbolic reference
    my $v; # original value
    my $rr;

    if ($opt_verbose) { print STDERR "Writing configuration file...\n";}
    while ($_ = shift @output_template) {
	if ($_ =~ /$mark(.+)$kram$mark(.+)$kram/) {
	    $r = $1;
	    $v = $2;
	    eval "\$_ =~ s/\$mark.*\$kram\$mark\$v\$kram/$r/";   # FIXME use $r.
	}
	print {$stream} $_;
    }
}

sub process_options {
    $opt_help = 0;
    $opt_quiet = 0;
    $opt_error = 1;
    $opt_warning = 1;
    $opt_advisory = 0;
    $opt_all = 0;
    $opt_verbose = 0;

    $result = GetOptions qw(--help --quiet --error! --warning! --advisory|d! --all --verbose);

    if ($opt_help) {
 	print STDOUT $info_help;
	exit 0;
    }
    if ($opt_all) {
	$opt_error = 1;
	$opt_warning = 1;
	$opt_advisory = 1;
    }
    if ($opt_quiet) {
        $opt_verbose = 0;
    }
    if ($#ARGV != 0) {
	print STDERR $info_usage;
	exit 1;
    }
}

# Main

	process_options();

	if (!$case_sensitive) {
		$re_mod .= "i";
	}
	open (INPUT, $ARGV[0]) || my_fail ($fail_openread, $ARGV[0]);
	read_conffile(INPUT);

	if ($worst_code == 3) {
		exit 1;  # was: $worst_code;
	} else {
		check_err_and_warn();
#		write_conffile("STDOUT");
	}

__END__

=head1 NAME

parse-xf86config - parse and edit the XF86Config file

=head1 SYNOPSIS

parse-xf86config [OPTION] ... FILE

  -h, --help        display this help and exit
  -q, --quiet       do not output anything
  -v, --verbose     act verbose

  -e, --errors      check for errors in FILE (default)
      --noerrors    do not check for errors in FILE
  -w, --warning     check for warnings in FILE (default)
      --nowarning   do not check for warnings in FILE
  -d, --advisory    check for advisories in FILE
      --noadvisory  do not check for advisories in FILE (default)
      --all         a shortcut for -e -w -d

=head1 DESCRIPTION

=head2 Purpose

parse-xf86config is a parser and editor for the XF86Config configuration
file for X servers released by the XFree86 Project, Inc.  The parser
checks if an existing file is valid; the editor should make it possible to
edit the file with front-end configuration programs.

It reads the content of the file and checks for validity of elements.
The output goes to standard out.

=head1 AUTHORS

Marcus Brinkmann <brinkmd@debian.org>
Branden Robinson <branden@debian.org>

=head1 HISTORY

=head2 Version 0.6.4.7

Monitor/Mode/Flags: Fixed quotes "", which apply to single flags, not
whole line (reported by Rene Hojbjerg Larsen). [MB]

=head2 Version 0.6.4.6

Fixed bug: DisableVidMode -> DisableVidModeExtension
(manpage got it wrong again) [BR]

=head2 Version 0.6.4.5

Update copyright and liability notices. [BR]

=head2 Version 0.6.4.4

Device/MemBase: Use 8 hex digits (?)
Wacom*: Allow more then one occurence.

=head2 Version 0.6.4.3

Stepped down Emulate3Buttons set when > 2 buttons on pointer from warning
to advisory, because xf86config and XF86Setup programs are dumb and will
create XF86Config files like that. [BR]

Changed all instances of "advice(s)" to "advisor(y/ies)". [BR]

=head2 Version 0.6.4.2

Fixed bug: S3RefClock -> S3RefClk 
Fixed bug: Monitor/Mode/Flags regex requires quotes "".
           (both reported by Rene Hojbjerg Larsen)

=head2 Version 0.6.4.1

Fixed bug: Clocks accepts now integer values (#30610, Fumitoshi UKAI).

=head2 Version 0.6.4

Now call consistency checks even when advisories or warnings occured (but not
in case of errors).

Mouse device can also be a FIFO, added a seperate existence check for the
mouse device file on the way. (#30390, bonnaud)

Fixed regex for DefaultColorDepth and Depth.

Added consistency checks for DefaultColorDepth and Depth values (I hope they
work in all cases).

Added Device/ChipRev (only for mach cards?).

=head2 Version 0.6.3

Accept pseudo subsection `Mode' only in `Monitor', to avoid conflict with
XInput (#28689, Charles C. Fu).

=head2 Version 0.6.2

Added '-' as valid character for hostnames. (Can somebody point me to the
correct RFC for hostnames?)

=head2 Version 0.6.1

Changed FontPath, RgbPath, ModulePath and Module to allow any character as
path resp. file name (Benjamin Redelings).

Fixed typo (missing '+') in RegEx for VertRefresh (#28338, Michael Babcock).

Fixed order of arguments for $adv_wrong_case.

Fixed use of $opt_warning in my_warn(), so warnings will be displayed
actually (YICK!).

Added line number diagnostics (#28294, J.H.M. Dassen).

=head2 Version 0.6

Added Monitor/Mode subsection. Lost about 4700 hairs because inconsistency
in the file syntax made me tear them. However, Mode section should now work
just the same way SubSection does.

During the above implementation, I fixed a major bug in the Require check,
which didn't work for Count'ed and MetaCount'ed sections at all. Look at the
code, and you know why I probably need a subfunction to apply a check to all
key/value pairs.

Another bug was fixed. 'Reset' did set value of Count to 0, but initial
value must be -1, to declare an empty start.

Fixed typo in usage message (errors -> error).

=head2 Version 0.5.1

Minor cosmetic changes. [BR]

=head2 Version 0.5

Introduced command line parsing and started with a few options which
control verbosity and checks. Also standard help option provided.

Check for VideoRam uses now 64 as basis size, to be compatible to some old
monochrome cards.

=head2 Version 0.4

XSpit now handles different spellings correctly, for example, ModeLine and
Modeline are the same.

Added check for VideoRam size (multiple of 256).

=head2 Version 0.3

Added data storage for sections with multiple occurences. A valid file comes
now out again unmodified (although actual data replacement takes place).
This proves that the data is stored and replaced unharmed. Still little
consistency checks, still no robust handling of element nesting. 

Added a few checks for the Pointer section, mainly for testing. 

=head2 Version 0.2

Added remaining elements, now all elements are supported. Still no
conistency checks. Data storage for multiple monitors etc has to be
implemented soon (at the moment, one field is overwritten). Need to make
Section and Subsection nesting more robust (one or two additional checks).

=head2 Version 0.1

Initial version. A completely reworked proof-of-concept. Features syntax
parsing of all elements beside Screen and XInput (which require SubSection).
No consistency checks, no warnings, no command line interface.

=head1 DIAGNOSTICS

The script returns 0 on success.

If an error occurs, an exit code of 1 will be returned. Otherwise 2 will
be returned in case of a warning and 3 if only advisories were given.

=head1 BUGS

As many as you find.

=head1 COPYRIGHT

Copyright 1998, 1999 by Marcus Brinkmann <Marcus.Brinkmann@ruhr-uni-bochum.de>.

You can find the terms of the license in the source code of the script.

=cut
