|
Lines 189-195
sub query_info($)
Link Here
|
| 189 |
my ($p) = @_; |
189 |
my ($p) = @_; |
| 190 |
my ($group, $ename) = $p =~ /^(.+?)\/(.+)$/; |
190 |
my ($group, $ename) = $p =~ /^(.+?)\/(.+)$/; |
| 191 |
my ($key, $value); |
191 |
my ($key, $value); |
| 192 |
my %vals; |
192 |
my @search_base = qw/CATEGORY HOSTNAME DESCRIPTION LICENSE SLOT/; |
|
|
193 |
my @search_base_switched = qw/PN PR PV HOMEPAGE/; |
| 194 |
my @search_keys = qw/NAME RELEASE VERSION URL PACKAGER/; |
| 195 |
my $search = join('|', (@search_base, @search_base_switched)); |
| 196 |
my %vals = map { $_,'' } (@search_base, @search_keys); |
| 193 |
my $ldbpath = "$dbpath/$p"; |
197 |
my $ldbpath = "$dbpath/$p"; |
| 194 |
my $fmt = <<EOT; |
198 |
my $fmt = <<EOT; |
| 195 |
Name : \%s |
199 |
Name : \%s |
|
Lines 206-213
EOT
Link Here
|
| 206 |
open(F, "bzcat $ldbpath/environment.bz2|") |
210 |
open(F, "bzcat $ldbpath/environment.bz2|") |
| 207 |
or die "epm: Can't open $ldbpath/environment.bz2: $!\n"; |
211 |
or die "epm: Can't open $ldbpath/environment.bz2: $!\n"; |
| 208 |
while (<F>) { |
212 |
while (<F>) { |
| 209 |
next unless (/^(CATEGORY|HOSTNAME|DESCRIPTION|HOMEPAGE|LICENSE|PN|PR|PV|SLOT)=(.*)/); |
213 |
next unless (/^(?:declare(?: -x)? )?($search)=(.*)/o); |
| 210 |
($key, $value) = ($1, $2); |
214 |
($key, $value) = ($1, $2); |
|
|
215 |
# if pulled from a declare -x line, then we need to delete the quotes |
| 216 |
# should be no harm in cleansing all $value |
| 217 |
$value =~ tr/"//d; #"avoid confusing syntax highlighting |
| 211 |
if ($key eq 'PN') { |
218 |
if ($key eq 'PN') { |
| 212 |
$key = 'NAME'; |
219 |
$key = 'NAME'; |
| 213 |
} elsif ($key eq 'PR') { |
220 |
} elsif ($key eq 'PR') { |
|
Lines 219-228
EOT
Link Here
|
| 219 |
$key = 'URL'; |
226 |
$key = 'URL'; |
| 220 |
$value = '(none)' unless $value; |
227 |
$value = '(none)' unless $value; |
| 221 |
} |
228 |
} |
|
|
229 |
|
| 222 |
# Clean up the double and single quotes |
230 |
# Clean up the double and single quotes |
| 223 |
$value =~ s/^'(.*)'$/$1/o; |
231 |
$value =~ s/^'(.*)'$/$1/o; |
| 224 |
$value =~ s/'\\''/'/go; |
232 |
$value =~ s/'\\''/'/go; |
| 225 |
$value =~ s/\\"/"/go; |
233 |
$value =~ s/\\"/"/go; #"avoid confusing syntax highlighting |
| 226 |
|
234 |
|
| 227 |
$vals{$key} = $value; |
235 |
$vals{$key} = $value; |
| 228 |
} |
236 |
} |
