trunk/perl-install/handle_configs.pm

package handle_configs;

# $Id: handle_configs.pm 204175 2003-09-17 19:25:59Z tvignaud $

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;
1	package handle_configs;
2
3	# $Id: handle_configs.pm 204175 2003-09-17 19:25:59Z tvignaud $
4
5	use diagnostics;
6	use strict;
7
8	use common;
9
10	sub searchstr {
11	# Preceed all characters which are special characters in regexps with
12	# a backslash, so that the returned string used in a regexp searches
13	# a literal occurence of the original string. White space is replaced
14	# by "\s+"
15	# "quotemeta()" does not serve for this, as it also quotes some regular
16	# characters, as the space
17	my ($s) = @_;
18	$s =~ s!([\\/\(\)\[\]\{\}\\|\.\$\@\%\*\?#\+\-])!\\$1!g;
19	return $s;
20	}
21
22	sub read_directives {
23	# Read one or more occurences of a directive
24	my ($lines_ptr, $directive) = @_;
25
26	my $searchdirective = searchstr($directive);
27	# do not use if_() below because it slow down printerdrake
28	# to the point one can believe in process freeze:
29	map { (/^\s$searchdirective\s+(\S.)$/ ? chomp_($1) : ()) } @$lines_ptr;
30	}
31
32	sub read_unique_directive {
33
34	# Read a directive, if the directive appears more than once, use
35	# the last occurence and remove all the others, if it does not
36	# occur, return the default value
37
38	my ($lines_ptr, $directive, $default) = @_;
39
40	if ((my @d = read_directives($lines_ptr, $directive)) > 0) {
41	my $value = $d[-1];
42	set_directive($lines_ptr, "$directive $value");
43	return $value;
44	} else {
45	return $default;
46	}
47	}
48
49	sub insert_directive {
50
51	# Insert a directive only if it is not already there
52
53	my ($lines_ptr, $directive) = @_;
54
55	my $searchdirective = searchstr($directive);
56	(/^\s*$searchdirective$/ and return 0) foreach @$lines_ptr;
57	push @$lines_ptr, "$directive\n";
58	return 1;
59	}
60
61	sub remove_directive {
62
63	# Remove a directive
64
65	my ($lines_ptr, $directive) = @_;
66
67	my $success = 0;
68	my $searchdirective = searchstr($directive);
69	(/^\s*$searchdirective/ and $_ = "" and $success = 1)
70	foreach @$lines_ptr;
71	return $success;
72	}
73
74	sub comment_directive {
75
76	# Comment out a directive
77
78	my ($lines_ptr, $directive, $exactmatch) = @_;
79
80	my $success = 0;
81	my $searchdirective = searchstr($directive);
82	$searchdirective .= ".*" if !$exactmatch;
83	(s/^\s*($searchdirective)$/#$1/ and $success = 1)
84	foreach @$lines_ptr;
85	return $success;
86	}
87
88	sub replace_directive {
89
90	# Replace a directive, if it appears more than once, remove
91	# the additional occurences.
92
93	my ($lines_ptr, $olddirective, $newdirective) = @_;
94
95	my $success = 0;
96	$newdirective = "$newdirective\n";
97	my $searcholddirective = searchstr($olddirective);
98	(/^\s*$searcholddirective/ and $_ = $newdirective and
99	$success = 1 and $newdirective = "") foreach @$lines_ptr;
100	return $success;
101	}
102
103
104	sub move_directive_to_version_commented_out {
105
106	# If there is a version of the directive "commentedout" which is
107	# commented out, the directive "directive" will be moved in its place.
108
109	my ($lines_ptr, $commentedout, $directive, $exactmatch) = @_;
110
111	my $success = 0;
112	my $searchcommentedout = searchstr($commentedout);
113	$searchcommentedout .= ".*" if !$exactmatch;
114	(/^\s*#$searchcommentedout$/ and
115	$success = 1 and last) foreach @$lines_ptr;
116	if ($success) {
117	remove_directive($lines_ptr, $directive);
118	(s/^\s*#($searchcommentedout)$/$directive/ and
119	$success = 1 and last) foreach @$lines_ptr;
120	}
121	return $success;
122	}
123
124	sub set_directive {
125
126	# Set a directive, replace the old definition or a commented definition
127
128	my ($lines_ptr, $directive, $full_line) = @_;
129
130	my $olddirective = $directive;
131	if (!$full_line) {
132	$olddirective =~ s/^\s(\S+)\s+.$/$1/s;
133	$olddirective \|\|= $directive;
134	}
135
136	my $success = (replace_directive($lines_ptr, $olddirective,
137	$directive) \|\|
138	insert_directive($lines_ptr, $directive));
139	if ($success) {
140	move_directive_to_version_commented_out($lines_ptr, $directive,
141	$directive, 1);
142	}
143	return $success;
144	}
145
146	sub add_directive {
147
148	# Add a directive, replace a commented definition
149
150	my ($lines_ptr, $directive) = @_;
151
152	my $success = insert_directive($lines_ptr, $directive);
153	if ($success) {
154	move_directive_to_version_commented_out($lines_ptr, $directive,
155	$directive, 1);
156	}
157	return $success;
158	}
159
160	1;