summaryrefslogtreecommitdiffstats
path: root/ChangeLog
Commit message (Expand)AuthorAgeFilesLines
* re-sync after the big svn lossPascal Rigaux2007-04-251-0/+142943
id='n13' href='#n13'>13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
package handle_configs;

# $Id$

use diagnostics;
use strict;

use common;

sub searchstr {
    # Preceed all characters which are special characters in regexps with
    # a backslash, so that the returned string used in a regexp searches
    # a literal occurence of the original string. White space is replaced
    # by "\s+"
    # "quotemeta()" does not serve for this, as it also quotes some regular
    # characters, as the space
    my ($s) = @_;
    $s =~ s!([\\/\(\)\[\]\{\}\|\.\$\@\%\*\?#\+\-])!\\$1!g;
    return $s;
}

sub read_directives {
    # Read one or more occurences of a directive
    my ($lines_ptr, $directive) = @_;

    my $searchdirective = searchstr($directive);
    # do not use if_() below because it slow down printerdrake
    # to the point one can believe in process freeze:
    map { (/^\s*$searchdirective\s+(\S.*)$/ ? chomp_($1) : ()) } @$lines_ptr;
}

sub read_unique_directive {

    # Read a directive, if the directive appears more than once, use
    # the last occurence and remove all the others, if it does not
    # occur, return the default value

    my ($lines_ptr, $directive, $default) = @_;

    if ((my @d = read_directives($lines_ptr, $directive)) > 0) {
	my $value = $d[-1];
	set_directive($lines_ptr, "$directive $value");
	return $value;
    } else {
        return $default;
    }
}

sub insert_directive {

    # Insert a directive only if it is not already there

    my ($lines_ptr, $directive) = @_;

    my $searchdirective = searchstr($directive);
    (/^\s*$searchdirective$/ and return 0) foreach @$lines_ptr;
    push @$lines_ptr, "$directive\n";
    return 1;
}

sub remove_directive {

    # Remove a directive

    my ($lines_ptr, $directive) = @_;

    my $success = 0;
    my $searchdirective = searchstr($directive);
    (/^\s*$searchdirective/ and $_ = "" and $success = 1)
	foreach @$lines_ptr;
    return $success;
}

sub comment_directive {

    # Comment out a directive

    my ($lines_ptr, $directive, $exactmatch) = @_;

    my $success = 0;
    my $searchdirective = searchstr($directive);
    $searchdirective .= ".*" if !$exactmatch;
    (s/^\s*($searchdirective)$/#$1/ and $success = 1)
	foreach @$lines_ptr;
    return $success;
}

sub replace_directive {

    # Replace a directive, if it appears more than once, remove
    # the additional occurences.

    my ($lines_ptr, $olddirective, $newdirective) = @_;

    my $success = 0;
    $newdirective = "$newdirective\n";
    my $searcholddirective = searchstr($olddirective);
    (/^\s*$searcholddirective/ and $_ = $newdirective and 
     $success = 1 and $newdirective = "") foreach @$lines_ptr;
    return $success;
}


sub move_directive_to_version_commented_out {

    # If there is a version of the directive "commentedout" which is
    # commented out, the directive "directive" will be moved in its place.

    my ($lines_ptr, $commentedout, $directive, $exactmatch) = @_;

    my $success = 0;
    my $searchcommentedout = searchstr($commentedout);
    $searchcommentedout .= ".*" if !$exactmatch;
    (/^\s*#$searchcommentedout$/ and 
     $success = 1 and last) foreach @$lines_ptr;
    if ($success) {
	remove_directive($lines_ptr, $directive);
	(s/^\s*#($searchcommentedout)$/$directive/ and 
	 $success = 1 and last) foreach @$lines_ptr;
    }
    return $success;
}

sub set_directive {

    # Set a directive, replace the old definition or a commented definition

    my ($lines_ptr, $directive, $full_line) = @_;

    my $olddirective = $directive;
    if (!$full_line) {
	$olddirective =~ s/^\s*(\S+)\s+.*$/$1/s;
	$olddirective ||= $directive;
    }

    my $success = (replace_directive($lines_ptr, $olddirective,
				     $directive) ||
		   insert_directive($lines_ptr, $directive));
    if ($success) {
	move_directive_to_version_commented_out($lines_ptr, $directive, 
						$directive, 1);
    }
    return $success;
}

sub add_directive {

    # Add a directive, replace a commented definition

    my ($lines_ptr, $directive) = @_;

    my $success = insert_directive($lines_ptr, $directive);
    if ($success) {
	move_directive_to_version_commented_out($lines_ptr, $directive, 
						$directive, 1);
    }
    return $success;
}

1;