1
2
3
4
5
6
7
8
9
10
11
12
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
|
package urpm::cfg;
use strict;
use warnings;
use urpm::util;
=head1 NAME
urpm::cfg - routines to handle the urpmi configuration files
=head1 SYNOPSIS
=head1 DESCRIPTION
=over
=item load_config($file)
Reads an urpmi configuration file and return its contents in a hash ref :
{
'medium name 1' => {
url => 'http://...',
option => 'value',
...
}
'' => {
# global options go here
},
}
Returns undef() in case of parsing error (and sets C<$urpm::cfg::err> to the
appropriate error message.)
=item dump_config($file, $config)
Does the opposite: write the configuration file, from the same data structure.
Returns 1 on success, 0 on failure.
=cut
our $err;
sub _syntax_error () { $err = N("syntax error in config file at line %s", $.) }
sub load_config ($) {
my ($file) = @_;
my %config;
my $medium = undef;
$err = '';
open my $f, $file or do { $err = N("unable to read config file [%s]", $file); return };
local $_;
while (<$f>) {
chomp;
next if /^\s*#/; #- comments
s/^\s+//; s/\s+$//;
if ($_ eq '}') { #-{
if (!defined $medium) {
_syntax_error;
return;
}
undef $medium;
next;
}
if (defined $medium && /{$/) { #-}
_syntax_error;
return;
}
if ($_ eq '{') { #-} Entering a global block
$medium = '';
next;
}
if (/^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/) { #-} medium definition
$config{ $medium = unquotespace $1 }{url} = unquotespace $2;
next;
}
#- config values
/^(hdlist
|list
|with_hdlist
|removable
|md5sum
|limit-rate
|excludepath
|split-(?:level|length)
|priority-upgrade
|downloader
)\s*:\s*(.*)$/x
and $config{$medium}{$1} = $2, next;
/^key[-_]ids\s*:\s*(.*)$/
and $config{$medium}{'key-ids'} = $1, next;
#- positive flags
/^(update|ignore|synthesis|virtual)$/
and $config{$medium}{$1} = 1, next;
my ($no, $k, $v);
#- boolean options
if (($no, $k, $v) = /^(no-)?(
verify-rpm
|fuzzy
|allow-(?:force|nodeps)
|(?:pre|post)-clean
|excludedocs
|compress
|keep
|auto
|resume)(?:\s*:\s*(.*))?$/x
) {
my $yes = $no ? 0 : 1;
$no = $yes ? 0 : 1;
$config{$medium}{$k} = $v =~ /^(yes|on|1|)$/i ? $yes : $no;
next;
}
#- obsolete
/^modified$/ and next;
}
close $f;
return \%config;
}
sub dump_config ($$) {
my ($file, $config) = @_;
my @media = sort {
return 0 if $a eq $b;
return -1 if $a eq '';
return 1 if $b eq '';
return $a cmp $b;
} keys %$config;
open my $f, '>', $file or do {
$err = N("unable to write config file [%s]", $file);
return 0;
};
print $f "# generated ".(scalar localtime)."\n";
for my $m (@media) {
if ($m) {
print $f quotespace($m), ' ', quotespace($config->{$m}{url}), " {\n";
} else {
print $f "{\n";
}
for (sort grep { $_ ne 'url' } keys %{$config->{$m}}) {
if (/^(update|ignore|synthesis|virtual)$/) {
print $f " $_\n";
} else {
print $f " $_: $config->{$m}{$_}\n";
}
}
print $f "}\n\n";
}
close $f;
return 1;
}
1;
__END__
=back
=cut
|
