#!perl -w

#  Copyright (c) 1995 Steffen Beyer. All rights reserved.
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.

require 5.000;

$self = $0;
$self =~ s!^.*/!!;
$self =~ s!^.*\\!!;
$self =~ s!\.[^.]*$!!;

$version = 'version 1.0';

$NULL = 0;

$head = \$NULL;
$tail = \$NULL;
$this = \$NULL;
$last = \$NULL;
$prev = \$NULL;
$next = \$NULL;

$delete_line = 0;
$insert_flag = 0;
$needs_update = 0;
$needs_writing = 0;

$warn_enable = 0;

$single_mode = 0;
$preserve_mode = 0;

$command = '';
$command_file = '';

$file = '';
$section = '';
$variable = '';
$assign = '';
$value = '';

$help = 0;
$header = '';
$backup = '';
$space = 0;
$cont = 0;

undef @specifier;
undef %sections;

%match =
(
    '<' => '>', 
    '[' => ']', 
    '"' => '"', 
    "'" => "'", 
);

$list = join('', keys(%match));

$pairs = join(' ',%match);

while (@ARGV)
{
    $_ = shift;
    if (/^-/)
    {
        if    (/^-[h?]/)                       { $help = 1; }
        elsif (/^-s$/)                         { $single_mode = 1; }
        elsif (/^-p$/)                         { $preserve_mode = 1; }
        elsif (/^-w$/)                         { $warn_enable = 1; }
        elsif (($file eq '') && (/^-f$/))      { $file = shift; }
        elsif (($file eq '') && (/^-f(\S+)$/)) { $file = $1; }
        else  { die "Unexpected option '$_' encountered!\n"; }
    }
    else
    {
        if ($command_file eq '') { $command_file = $_; }
        else { die "Unexpected parameter '$_' encountered!\n"; }
    }
}

if ($help)
{
    &usage;
    exit;
}

if ($command_file ne '')
{
    unless (-f $command_file)
    {
        die "Command file <$command_file> does not exist!\n";
    }
    unless (open(COMMANDS, "<$command_file"))
    {
        die "Can't open command file <$command_file>: $!\n";
    }
}
else
{
    unless (open(COMMANDS, "-"))
    {
        die "Can't open STDIN: $!\n";
    }
}

if ($file ne '')
{
    &read_file;
    $section = '';
    $variable = '';
}

COMMAND:
while ($command = <COMMANDS>)
{
    $command =~ s/^\s+//;
    $command =~ s/\s+$//;
    next COMMAND if ($command =~ /^[;#]/);
    next COMMAND if ($command =~ /^rem\s/i);
    if ($command eq '')
    {
        if (-t COMMANDS) { &usage; }
        next COMMAND;
    }
    $needs_update = 0;
    if ($command =~ /=/)
    {
        $needs_update = 1;
        ($command,$assign) = split(/=/,$command,2);
        $command =~ s/\s+$//;
        $assign =~ s/^\s+//;
        $delete_line = 0;
        if ($assign eq '')
        {
            unless ($preserve_mode) { $delete_line = 1; }
        }
        else
        {
            unless ($single_mode) { $assign = &mychop($assign); }
        }
    }
    undef @specifier;
    if ($single_mode) { $specifier[0] = &mychop($command); }
    else              { @specifier    = &mysplit($command); }
    if (@specifier == 0)
    {
        warn "Can't execute command - no specifier in line $..\n";
        next COMMAND;
    }
    if (@specifier > 3)
    {
        warn "Can't execute command - too many specifiers in line $..\n";
        next COMMAND;
    }
    foreach (@specifier)
    {
        s/[\t\r\n]/ /g;
        s/  +/ /g;
    }
    if (@specifier == 3)
    {
        &write_file;
        $file = $specifier[0];
        &read_file;
        $section = $specifier[1];
        $variable = $specifier[2];
    }
    elsif (@specifier == 2)
    {
        $section = $specifier[0];
        $variable = $specifier[1];
    }
    else
    {
        if ($command =~ /^<.*>$/)
        {
            &write_file;
            $file = $specifier[0];
            &read_file;
            $section = '';
            $variable = '';
            next COMMAND;
        }
        elsif ($command =~ /^\[.*\]$/)
        {
            $section = $specifier[0];
            $variable = '';
            next COMMAND;
        }
        else
        {
            $variable = $specifier[0];
        }
    }
    if ($file eq '')
    {
        warn "Can't execute command - no file specified in line $..\n";
        next COMMAND;
    }
    if ($section eq '')
    {
        warn "Can't execute command - no section specified in line $..\n";
        next COMMAND;
    }
    if ($variable eq '')
    {
        warn "Can't execute command - no variable specified in line $..\n";
        next COMMAND;
    }
    if ($section eq '*')
    {
        if ($needs_update)
        {
            warn "Assignment to more than one section not allowed in line $..\n";
            next COMMAND;
        }
        else
        {
            if ($variable ne '*')
            {
                warn "Variable '$variable' ignored, assuming '*' in line $..\n";
            }
            &list_heads;
        }
    }
    else
    {
        if ($variable eq '*')
        {
            if ($needs_update)
            {
                warn "Assignment to more than one variable not allowed in line $..\n";
                next COMMAND;
            }
            else
            {
                &list_all;
            }
        }
        else
        {
            if ($needs_update)
            {
                if ($delete_line)
                {
                    &del_var;
                }
                else
                {
                    &put_var;
                }
            }
            else
            {
                &list_one;
            }
        }
    }
}

&write_file;

exit;

sub read_file
{
    $needs_writing = 0;
    $insert_flag = 0;
    undef %sections;
    $head = \$NULL;
    $tail = \$NULL;

    unless (-f $file)
    {
        warn "File <$file> does not exist!\n";
        $file = '';
        return;
    }
    unless (open(FILE, "<$file"))
    {
        warn "Can't read file <$file>: $!\n";
        $file = '';
        return;
    }
    LINE:
    while (<FILE>)
    {
        s/^\s+//;
        s/\s+$//;
        next if /^$/;
        if ((/^;/) || (/^rem\s/i))
        {
            $this = [ \$NULL, '', $_, \$NULL ];
            if ($insert_flag) { &insert; } else { &append; }
        }
        elsif (/^\[(.*)\]$/)
        {
            $section = $1;
            $section =~ s/^\s+//;
            $section =~ s/\s+$//;
            $section =~ s/[\t\r\n]/ /g;
            $section =~ s/  +/ /g;
            if (defined $sections{$section})
            {
                warn "Section [$section] defined more than once in <$file>!\n";
                $needs_writing = 1;
                $insert_flag = 1;
            }
            else
            {
                $insert_flag = 0;
                $this = [ \$NULL, '', "[$section]", \$NULL ];
                $sections{$section} = [ $this, $this, { } ];
                &append;
            }
        }
        elsif (/=/)
        {
            unless ((ref($head) =~ /ARRAY/) && (ref($tail) =~ /ARRAY/))
            {
                warn "'$_'\n";
                warn "Deleting line above (no section header) in <$file>!\n";
                $needs_writing = 1;
                next LINE;
            }
            ($variable,$value) = split(/=/,$_,2);
            $variable =~ s/\s+$//;
            $variable =~ s/[\t\r\n]/ /g;
            $variable =~ s/  +/ /g;
            $value =~ s/^\s+//;
            if (defined $sections{$section}->[2]->{$variable})
            {
                warn "Variable '$variable' in section [$section] defined more than once in <$file>!\n" if $warn_enable;
            }
            $this = [ \$NULL, $variable, $value, \$NULL ];
            $sections{$section}->[2]->{$variable} = $this;
            if ($insert_flag) { &insert; } else { &append; }
        }
        else
        {
            warn "'$_'\n";
            warn "Deleting line above (unable to parse) in <$file>!\n";
            $needs_writing = 1;
            next LINE;
        }
    }
    close(FILE);
}

sub write_file
{
    if ($needs_writing)
    {
        $backup = $file;
        $backup =~ s!\.[^.]*$!!;
        $backup .= ".bak";
        if (-e $backup)
        {
            if (-f $backup)
            {
                if (unlink($backup) != 1)
                {
                    warn "Can't delete file <$backup>!\n";
                    warn "Changes will be lost!\n";
                    return;
                }
            }
            else
            {
                warn "Can't delete <$backup>!\n";
                warn "Changes will be lost!\n";
                return;
            }
        }
        unless (rename($file,$backup))
        {
            warn "Can't rename file <$file> to <$backup>: $!\n";
            warn "Changes will be lost!\n";
            return;
        }
        unless (open(FILE, ">$file"))
        {
            warn "Can't write file <$file>: $!\n";
            warn "Changes will be lost!\n";
            return;
        }
        $space = 0;
        $this = $head;
        while (ref($this) =~ /ARRAY/)
        {
            if ($this->[1] eq '')
            {
                if (($this->[2] !~ /^;/) &&
                    ($this->[2] !~ /^rem\s/i) &&
                    ($space))
                { print FILE "\n"; }
                print FILE $this->[2], "\n";
            }
            else
            {
                print FILE $this->[1], "=", $this->[2], "\n";
            }
            $this = $this->[0];
            $space = 1;
        }
        close(FILE);
    }
}

sub mychop
{
    my($s) = shift;
    my($m);

    $s =~ s/^\s+//;
    $s =~ s/\s+$//;
    if ($s =~ /^([$list])/o)
    {
        $m = $1;
        if ($s =~ /.$match{$m}$/)
        {
            $s =~ s/^.\s*//;
            $s =~ s/\s*.$//;
        }
    }
    return($s);
}

sub mysplit
{
    my($s) = shift;
    my($l,$m,$r);
    my(@t);

    $s =~ s/^\s+//;
    $s =~ s/\s+$//;
    while (($s =~ /^([$list])/o) || ($s =~ /\s([$list])/o))
    {
        $l = $`;
        $m = $1;
        $r = $';
        if (($r =~ /$match{$m}\s/) || ($r =~ /$match{$m}$/))
        {
            $m = $`;
            $s = $';
            $s =~ s/^\s+//;
            $m =~ s/^\s+//;
            $m =~ s/\s+$//;
            $l =~ s/\s+$//;
            push(@t, split(/\s+/,$l), $m);
        }
        else
        {
            push(@t, split(/\s+/,$s));
            $s = '';
        }
    }
    if ($s ne '')
    {
        push(@t, split(/\s+/,$s));
    }
    return(@t);
}

sub list_heads
{
    unless ((-t STDOUT) && (open(MORE, "| more")))
    {
        unless (open(MORE, ">-"))
        {
            warn "Can't open STDOUT: $!\n";
            return;
        }
    }
    foreach $header (sort keys(%sections))
    {
        print MORE "<$file> ", $sections{$header}->[0]->[2], "\n";
    }
    close(MORE);
}

sub list_all
{
    if (defined $sections{$section})
    {
        unless ((-t STDOUT) && (open(MORE, "| more")))
        {
            unless (open(MORE, ">-"))
            {
                warn "Can't open STDOUT: $!\n";
                return;
            }
        }
        $this = $sections{$section}->[0];
        $last = $sections{$section}->[1];
        $cont = 1;
        while (($cont) && (ref($this) =~ /ARRAY/))
        {
            if ($this->[1] eq '')
            {
                if (($this->[2] !~ /^;/) &&
                    ($this->[2] !~ /^rem\s/i))
                { print MORE "<$file> ", $this->[2], "\n"; }
            }
            else
            {
                print MORE "<$file> ", $this->[1], "=", $this->[2], "\n";
            }
            $cont = ($this != $last);
            $this = $this->[0];
        }
        close(MORE);
    }
}

sub list_one
{
    if (defined $sections{$section})
    {
        if (defined $sections{$section}->[2]->{$variable})
        {
            $this = $sections{$section}->[2]->{$variable};
            print "<$file> [$section] ", $this->[1], "=", $this->[2], "\n";
        }
    }
}

sub put_var
{
    if (defined $sections{$section})
    {
        if (defined $sections{$section}->[2]->{$variable})
        {
            $this = $sections{$section}->[2]->{$variable};
            $this->[2] = $assign;
            $needs_writing = 1;
            &list_one;
        }
        elsif (defined $sections{$section}->[1])
        {
            $this = [ \$NULL, $variable, $assign, \$NULL ];
            $sections{$section}->[2]->{$variable} = $this;
            &insert;
            $needs_writing = 1;
            &list_one;
        }
        else { warn "System error in $self!\n"; }
    }
    else
    {
        $this = [ \$NULL, '', "[$section]", \$NULL ];
        $sections{$section} = [ $this, $this, { } ];
        &append;
        $this = [ \$NULL, $variable, $assign, \$NULL ];
        $sections{$section}->[2]->{$variable} = $this;
        &append;
        $needs_writing = 1;
        &list_one;
    }
}

sub del_var
{
    if (defined $sections{$section})
    {
        if (defined $sections{$section}->[2]->{$variable})
        {
            $this = $sections{$section}->[2]->{$variable};
            &remove;
            delete($sections{$section}->[2]->{$variable});
            $needs_writing = 1;
            print "<$file> [$section] ", $this->[1], " - deleted\n";
            if ($sections{$section}->[0] == $sections{$section}->[1])
            {
                $this = $sections{$section}->[0];
                &remove;
                delete($sections{$section});
                print "<$file> [$section] - deleted\n";
            }
        }
    }
}

sub append
{
    if ((ref($head) =~ /ARRAY/) && (ref($tail) =~ /ARRAY/))
    {
        $tail->[0] = $this;
        $this->[3] = $tail;
        $tail = $this;
    }
    else
    {
        $head = $this;
        $tail = $this;
    }
    if (defined $sections{$section}) { $sections{$section}->[1] = $this; }
}

sub insert
{
    if ((ref($head) =~ /ARRAY/) && (ref($tail) =~ /ARRAY/))
    {
        $last = $sections{$section}->[1];
        $next = $last->[0];
        $this->[0] = $next;
        $this->[3] = $last;
        $last->[0] = $this;
        if (ref($next) =~ /ARRAY/)
            { $next->[3] = $this; }
        else
            { $tail = $this; }
    }
    else
    {
        $head = $this;
        $tail = $this;
    }
    $sections{$section}->[1] = $this;
}

sub remove
{
    $next = $this->[0];
    $prev = $this->[3];
    if (ref($prev) =~ /ARRAY/)
        { $prev->[0] = $next; }
    else
        { $head = $next; }
    if (ref($next) =~ /ARRAY/)
        { $next->[3] = $prev; }
    else
        { $tail = $prev; }
    $last = $sections{$section}->[1];
    if ((ref($last) =~ /ARRAY/) && ($last == $this))
    {
        $sections{$section}->[1] = $prev;
    }
}

sub usage
{
    unless ((-t STDOUT) && (open(MORE, "| more")))
    {
        unless (open(MORE, ">-"))
        {
            warn "Can't open STDOUT: $!\n";
            return;
        }
    }
    print MORE <<"VERBATIM";

$self $version usage:

$self { -h | -? } { -s } { -p } { -w } { -f _file_ } { _command-file_ }

_command-file_ or commands given at the keyboard consist of lines of the form:

     {  _file_  }     "*"           "*"                                     1)

     {  _file_  }  _section_        "*"                                     2)

  {  {  _file_  }  _section_  }  _variable_  {  "="  {  _value_  }  }       3)

                                 _variable_  {  "="  {  _value_  }  }       4)

    "<" _file_ ">"    |    "[" _section_ "]"    |    "[*]"    |    "*"      5)

  1)       - display all section headers in _file_

  2)       - display all variables of a _section_

  3) + 4)  - display or assign to a _variable_

  5)       - set the corresponding specifier or display ("*") as in 1) or 2)

  - with option "-s" (= "single mode"), ONLY 4) and 5) are allowed
    (this allows the use of an ini-_file_ as a _command-file_)

  - a command line without "=" is a display (or set specifier) command

  - a command line containing "=" is an assignment command

  - an assignment command without value (i.e., "variable=") removes the
    _variable_ (unless option "-p" (= "preserve mode") has been specified)

  - an assignment command with empty value (i.e., "variable=''") yields
    "variable=" (unless option "-s" (= "single mode") has been specified)

  - you may enclose any string in $pairs

  - option "-w" enables certain warnings (variable name not unique)

VERBATIM
    close(MORE);
}

__END__