summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm134
1 files changed, 67 insertions, 67 deletions
diff --git a/urpm.pm b/urpm.pm
index f0d831fa..9220ef91 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -53,7 +53,7 @@ sub new {
error => sub { printf STDERR "%s\n", $_[0] },
log => sub { printf STDERR "%s\n", $_[0] },
- ui_msg => sub { $self->{log}($_[0]); $self->{ui} and $self->{ui}{msg}->($_[1]); },
+ ui_msg => sub { $self->{log}($_[0]); $self->{ui} and $self->{ui}{msg}->($_[1]) },
}, $class;
}
@@ -148,7 +148,7 @@ sub sync_webfetch {
if ($files{ssh}) {
my @ssh_files;
foreach (@{$files{ssh} || []}) {
- /^ssh:\/\/([^\/]*)(.*)/ and push @ssh_files, "$1:$2";
+ m|^ssh://([^/]*)(.*)| and push @ssh_files, "$1:$2";
}
sync_ssh($options, @ssh_files);
delete $files{ssh};
@@ -171,7 +171,7 @@ sub propagate_sync_callback {
sub sync_file {
my $options = shift @_;
foreach (@_) {
- my ($in) = /^(?:removable[^:]*|file):\/(.*)/;
+ my ($in) = m!^(?:removable[^:]*|file):/(.*)!;
propagate_sync_callback($options, 'start', $_);
system("cp", "-p", "-R", $in || $_, ref($options) ? $options->{dir} : $options) and
die N("copy failed: %s", $@);
@@ -236,7 +236,7 @@ sub sync_curl {
chdir(ref($options) ? $options->{dir} : $options);
my (@ftp_files, @other_files);
foreach (@_) {
- /^ftp:\/\/.*\/([^\/]*)$/ && -s $1 > 8192 and do { push @ftp_files, $_; next }; #- manage time stamp for large file only.
+ m|^ftp://.*/([^/]*)$| && -s $1 > 8192 and do { push @ftp_files, $_; next }; #- manage time stamp for large file only.
push @other_files, $_;
}
if (@ftp_files) {
@@ -273,7 +273,7 @@ sub sync_curl {
#- for that, it should be clear ftp_files is empty... else a above work is
#- use less.
foreach (keys %ftp_files_info) {
- my ($lfile) = /\/([^\/]*)$/ or next; #- strange if we can't parse it correctly.
+ my ($lfile) = m|/([^/]*)$| or next; #- strange if we can't parse it correctly.
my $ltime = eval { Date::Manip::ParseDate(scalar gmtime((stat $1)[9])) };
$ltime =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour.
-s $lfile == $ftp_files_info{$_}{size} && $ftp_files_info{$_}{time} eq $ltime or
@@ -284,7 +284,7 @@ sub sync_curl {
#- http files (and other files) are correctly managed by curl to conditionnal download.
#- options for ftp files, -R (-O <file>)*
#- options for http files, -R (-z file -O <file>)*
- if (my @all_files = ((map { ("-O", $_) } @ftp_files), (map { /\/([^\/]*)$/ ? ("-z", $1, "-O", $_) : @{[]} } @other_files))) {
+ if (my @all_files = ((map { ("-O", $_) } @ftp_files), (map { m|/([^/]*)$| ? ("-z", $1, "-O", $_) : @{[]} } @other_files))) {
my @l = (@ftp_files, @other_files);
my ($buf, $file) = ('', undef);
my $curl_pid = open CURL, join(" ", map { "'$_'" } "/usr/bin/curl",
@@ -342,7 +342,7 @@ sub sync_rsync {
foreach (@_) {
my $count = 10; #- retry count on error (if file exists).
my $basename = basename($_);
- my ($file) = /^rsync:\/\/(.*)/ or next; $file =~ /::/ or $file = $_;
+ my ($file) = m|^rsync://(.*)| or next; $file =~ /::/ or $file = $_;
propagate_sync_callback($options, 'start', $file);
do {
local (*RSYNC, $_);
@@ -350,7 +350,7 @@ sub sync_rsync {
open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync",
($limit_rate ? "--bwlimit=$limit_rate" : ()),
(ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)),
- (ref($options) && $options->{compress} ? qw(-z) : ()),
+ if_(ref($options) && $options->{compress}, qw(-z)),
qw(--partial --no-whole-file), $file, (ref($options) ? $options->{dir} : $options)) . " |";
local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
while (<RSYNC>) {
@@ -397,7 +397,7 @@ sub sync_ssh {
open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync",
($limit_rate ? "--bwlimit=$limit_rate" : ()),
(ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)),
- (ref($options) && $options->{compress} ? qw(-z) : ()),
+ if_(ref($options) && $options->{compress}, qw(-z)),
qw(--partial -e ssh), $file, (ref($options) ? $options->{dir} : $options)) . " |";
local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
while (<RSYNC>) {
@@ -528,7 +528,7 @@ sub read_config {
#- urpmi.cfg if old is not enough to known the various media, track
#- directly into /var/lib/urpmi,
foreach (glob("$urpm->{statedir}/hdlist.*")) {
- if (/\/hdlist\.((.*)\.cz2?)$/) {
+ if (m|/hdlist\.((.*)\.cz2?)$|) {
#- check if it has already been detected above.
exists($hdlists{"hdlist.$1"}) and next;
@@ -632,8 +632,8 @@ sub probe_medium {
#- /./ is end of url marker in list file (typically generated by a
#- find . -name "*.rpm" > list
#- for exportable list file.
- /^(.*)\/\.\// and $probe{$1} = undef;
- /^(.*)\/[^\/]*$/ and $probe{$1} = undef;
+ m|^(.*)/\./| and $probe{$1} = undef;
+ m|^(.*)/[^/]*$| and $probe{$1} = undef;
}
close L;
}
@@ -677,7 +677,7 @@ sub probe_removable_device {
#- try to find device to open/close for removable medium.
if (exists($medium->{removable})) {
- if (my ($dir) = $medium->{url} =~ /(?:file|removable)[^:]*:\/(.*)/) {
+ if (my ($dir) = $medium->{url} =~ m!(?:file|removable)[^:]*:/(.*)!) {
my %infos;
my @mntpoints = $urpm->find_mntpoints($dir, \%infos);
if (@mntpoints > 1) { #- return value is suitable for an hash.
@@ -837,9 +837,9 @@ sub configure {
my $second_pass;
do {
foreach (grep { !$_->{ignore} && (!$options{update} || $_->{update}) } @{$urpm->{media} || []}) {
- delete @{$_}{qw(start end)};
+ delete @$_{qw(start end)};
if ($_->{virtual}) {
- my $path = $_->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/ && $1;
+ my $path = $_->{url} =~ m|^file:/*(/[^/].*[^/])/*$| && $1;
if ($path) {
if ($_->{synthesis}) {
$urpm->{log}(N("examining synthesis file [%s]", "$path/$_->{with_hdlist}"));
@@ -934,7 +934,7 @@ sub add_medium {
#- make sure configuration has been read.
# (Olivier Thauvin) Yes but Why ??? Is this a workaround ?
- $urpm->{media} or $urpm->read_config();
+ $urpm->{media} or $urpm->read_config;
#- if a medium with that name has already been found
#- we have to exit now
@@ -979,7 +979,7 @@ sub add_medium {
};
#- check to see if the medium is using file protocol or removable medium.
- $url =~ /^(removable[^:]*|file):\/(.*)/ and $urpm->probe_removable_device($medium);
+ $url =~ m!^(removable[^:]*|file):/(.*)! and $urpm->probe_removable_device($medium);
}
#- check if a password is visible, if not set clear_url.
@@ -1003,10 +1003,10 @@ sub add_distrib_media {
#- make sure configuration has been read.
# (Olivier Thauvin): Is this a workaround ?
- $urpm->{media} or $urpm->read_config();
+ $urpm->{media} or $urpm->read_config;
#- try to copy/retrive Mandrake/basehdlists file.
- if (my ($dir) = $url =~ /^(?:removable[^:]*|file):\/(.*)/) {
+ if (my ($dir) = $url =~ m!^(?:removable[^:]*|file):/(.*)!) {
$hdlists_file = reduce_pathname("$dir/Mandrake/base/hdlists");
$urpm->try_mounting($hdlists_file) or $urpm->{error}(N("unable to access first installation medium")), return;
@@ -1206,9 +1206,9 @@ sub update_media {
#- we still need to read it and all synthesis will be written if
#- a unresolved provides is found.
#- to speed up the process, we only read the synthesis at the begining.
- delete @{$medium}{qw(start end)};
+ delete @$medium{qw(start end)};
if ($medium->{virtual}) {
- my ($path) = $medium->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/;
+ my ($path) = $medium->{url} =~ m|^file:/*(/[^/].*[^/])/*$|;
my $with_hdlist_file = "$path/$medium->{with_hdlist}";
if ($path) {
if ($medium->{synthesis}) {
@@ -1250,7 +1250,7 @@ sub update_media {
}
#- check to see if the medium is using file protocol or removable medium.
- if (($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
+ if (($prefix, $dir) = $medium->{url} =~ m!^(removable[^:]*|file):/(.*)!) {
#- try to figure a possible hdlist_path (or parent directory of searched directory.
#- this is used to probe possible hdlist file.
my $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/.."));
@@ -1266,7 +1266,7 @@ this could happen if you mounted manually the directory when creating the medium
#- try to probe for possible with_hdlist parameter, unless
#- it is already defined (and valid).
if ($options{probe_with} && (!$medium->{with_hdlist} || ! -e "$dir/$medium->{with_hdlist}")) {
- my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/;
+ my ($suffix) = $dir =~ m|RPMS([^/]*)/*$|;
foreach (probe_with_try_list($suffix, $options{probe_with})) {
if (-s "$dir/$_" > 32) {
@@ -1282,7 +1282,7 @@ this could happen if you mounted manually the directory when creating the medium
#- syncing a virtual medium is very simple, just try to read the file in order to
#- determine its type, once a with_hdlist has been found (but is mandatory).
if ($medium->{with_hdlist} && -e $with_hdlist_dir) {
- delete @{$medium}{qw(start end)};
+ delete @$medium{qw(start end)};
if ($medium->{synthesis}) {
$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_dir));
eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis($with_hdlist_dir);
@@ -1292,13 +1292,13 @@ this could happen if you mounted manually the directory when creating the medium
unless (defined $medium->{start} && defined $medium->{end}) {
$urpm->{log}(N("examining hdlist file [%s]", $with_hdlist_dir));
eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist($with_hdlist_dir, packing => 1);
- delete @{$medium}{qw(modified synthesis)};
+ delete @$medium{qw(modified synthesis)};
$urpm->{modified} = 1 };
}
} else {
$urpm->{log}(N("examining hdlist file [%s]", $with_hdlist_dir));
eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist($with_hdlist_dir, packing => 1);
- delete @{$medium}{qw(modified synthesis)};
+ delete @$medium{qw(modified synthesis)};
$urpm->{modified} = 1 };
unless (defined $medium->{start} && defined $medium->{end}) {
$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_dir));
@@ -1359,7 +1359,7 @@ this could happen if you mounted manually the directory when creating the medium
local (*F, $_);
open F, reduce_pathname("$with_hdlist_dir/../MD5SUM");
while (<F>) {
- my ($md5sum, $file) = /(\S+)\s+(?:\.\/)?(\S+)/ or next;
+ my ($md5sum, $file) = m|(\S+)\s+(?:\./)?(\S+)| or next;
#- keep md5sum got here to check download was ok ! so even if md5sum is not defined, we need
#- to compute it, keep it in mind ;)
$file eq $basename and $retrieved_md5sum = $md5sum;
@@ -1588,7 +1588,7 @@ this could happen if you mounted manually the directory when creating the medium
local (*F, $_);
open F, "$urpm->{cachedir}/partial/MD5SUM";
while (<F>) {
- my ($md5sum, $file) = /(\S+)\s+(?:\.\/)?(\S+)/ or next;
+ my ($md5sum, $file) = m|(\S+)\s+(?:\./)?(\S+)| or next;
#- keep md5sum got here to check download was ok ! so even if md5sum is not defined, we need
#- to compute it, keep it in mind ;)
$file eq $basename and $retrieved_md5sum = $md5sum;
@@ -1642,7 +1642,7 @@ this could happen if you mounted manually the directory when creating the medium
$urpm->{log}(N("retrieving source hdlist (or synthesis) of \"%s\"...", $medium->{name}));
$options{callback} && $options{callback}('retrieve', $medium->{name});
if ($options{probe_with}) {
- my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/;
+ my ($suffix) = $dir =~ m|RPMS([^/]*)/*$|;
foreach my $with_hdlist ($medium->{with_hdlist}, probe_with_try_list($suffix, $options{probe_with})) {
$basename = basename($with_hdlist) or next;
@@ -1794,7 +1794,7 @@ this could happen if you mounted manually the directory when creating the medium
#- rpm files have already been read (first pass), there is just a need to
#- build list hash.
foreach (@files) {
- /\/([^\/]*\.rpm)$/ or next;
+ m|/([^/]*\.rpm)$| or next;
$list{$1} and $urpm->{error}(N("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
$list{$1} = "$prefix:/$_\n";
}
@@ -1829,13 +1829,13 @@ this could happen if you mounted manually the directory when creating the medium
defined $medium->{start} && defined $medium->{end} and delete $medium->{synthesis};
}
}
- unless (defined $medium->{start} && defined $medium->{end}) {
+ if (defined $medium->{start} && defined $medium->{end}) {
+ $options{callback} && $options{callback}('done', $medium->{name});
+ } else {
$error = 1;
$urpm->{error}(N("unable to parse hdlist file of \"%s\"", $medium->{name}));
$options{callback} && $options{callback}('failed', $medium->{name});
#- we will have to read back the current synthesis file unmodified.
- } else {
- $options{callback} && $options{callback}('done', $medium->{name});
}
unless ($error) {
@@ -1846,7 +1846,7 @@ this could happen if you mounted manually the directory when creating the medium
local (*F, $_);
open F, "$urpm->{cachedir}/partial/list";
while (<F>) {
- /\/([^\/]*\.rpm)$/ or next;
+ m|/([^/]*\.rpm)$| or next;
$list{$1} and $urpm->{error}(N("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
$list{$1} = "$medium->{url}/$_";
}
@@ -1992,7 +1992,7 @@ this could happen if you mounted manually the directory when creating the medium
} elsif ($medium->{synthesis}) {
if ($second_pass) {
if ($medium->{virtual}) {
- my ($path) = $medium->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/;
+ my ($path) = $medium->{url} =~ m|^file:/*(/[^/].*[^/])/*$|;
my $with_hdlist_file = "$path/$medium->{with_hdlist}";
if ($path) {
$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_file));
@@ -2032,7 +2032,7 @@ this could happen if you mounted manually the directory when creating the medium
my %headers;
opendir D, "$urpm->{cachedir}/headers";
while (defined($_ = readdir D)) {
- /^([^\/]*-[^-]*-[^-]*\.[^\.]*)(?::\S*)?$/ and $headers{$1} = $_;
+ m|^([^/]*-[^-]*-[^-]*\.[^\.]*)(?::\S*)?$| and $headers{$1} = $_;
}
closedir D;
$urpm->{log}(N("found %d headers in cache", scalar(keys %headers)));
@@ -2046,7 +2046,7 @@ this could happen if you mounted manually the directory when creating the medium
}
#- this file is written in any cases.
- $urpm->write_config();
+ $urpm->write_config;
}
#- make sure names files are regenerated.
@@ -2087,7 +2087,7 @@ sub is_using_supermount {
#- read /etc/fstab and check for existing mount point.
open F, "/etc/fstab";
while (<F>) {
- my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
+ my ($device, $mntpoint, $fstype, $options) = m|^\s*(\S+)\s+(/\S+)\s+(\S+)\s+(\S+)| or next;
$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
if ($fstype eq 'supermount') {
$device_mntpoint eq $mntpoint and return 1;
@@ -2107,7 +2107,7 @@ sub find_mntpoints {
#- read /etc/fstab and check for existing mount point.
open F, "/etc/fstab";
while (<F>) {
- my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
+ my ($device, $mntpoint, $fstype, $options) = m|^\s*(\S+)\s+(/\S+)\s+(\S+)\s+(\S+)| or next;
$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
$fstab{$mntpoint} = 0;
if (ref($infos)) {
@@ -2121,7 +2121,7 @@ sub find_mntpoints {
}
open F, "/etc/mtab";
while (<F>) {
- my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
+ my ($device, $mntpoint, $fstype, $options) = m|^\s*(\S+)\s+(/\S+)\s+(\S+)\s+(\S+)| or next;
$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
$fstab{$mntpoint} = 1;
if (ref($infos)) {
@@ -2156,12 +2156,12 @@ sub find_mntpoints {
last;
} elsif (-l $pdir) {
while ($v = readlink $pdir) {
- if ($pdir =~ /^\//) {
+ if ($pdir =~ m|^/|) {
$pdir = $v;
} else {
- while ($v =~ /^\.\.\/(.*)/) {
+ while ($v =~ m|^\.\./(.*)|) {
$v = $1;
- $pdir =~ s/^(.*)\/[^\/]+\/*/$1/;
+ $pdir =~ s|^(.*)/[^/]+/*|$1|;
}
$pdir .= "/$v";
}
@@ -2180,23 +2180,23 @@ sub reduce_pathname {
#- clean url to remove any macro (which cannot be solved now).
#- take care if this is a true url and not a simple pathname.
- my ($host, $dir) = $url =~ /([^:\/]*:\/\/[^\/]*\/)?(.*)/;
+ my ($host, $dir) = $url =~ m|([^:/]*://[^/]*/)?(.*)|;
#- remove any multiple /s or trailing /.
#- then split all components of pathname.
- $dir =~ s/\/+/\//g; $dir =~ s/\/$//;
+ $dir =~ s|/+|/|g; $dir =~ s|/$||;
my @paths = split '/', $dir;
#- reset $dir, recompose it, and clean trailing / added by algorithm.
$dir = '';
foreach (@paths) {
if ($_ eq '..') {
- $dir =~ s/([^\/]+)\/$// or $dir .= "../";
+ $dir =~ s|([^/]+)/$|| or $dir .= "../";
} elsif ($_ ne '.') {
$dir .= "$_/";
}
}
- $dir =~ s/\/$//;
+ $dir =~ s|/$||;
$dir ||= '/';
$host . $dir;
@@ -2261,7 +2261,7 @@ sub register_rpms {
/\.rpm$/ or $error = 1, $urpm->{error}(N("invalid rpm file name [%s]", $_)), next;
#- allow url to be given.
- if (my ($basename) = /^[^:]*:\/.*\/([^\/]*\.rpm)$/) {
+ if (my ($basename) = m|^[^:]*:/.*/([^/]*\.rpm)$|) {
unlink "$urpm->{cachedir}/partial/$basename";
eval {
$urpm->{log}(N("retrieving rpm file [%s] ...", $_));
@@ -2300,12 +2300,12 @@ sub search_packages {
#- try to search through provides.
if (my @l = map { $_ && ($options{src} ? $_->arch eq 'src' : $_->is_arch_compat) &&
($options{use_provides} || $_->name eq $v) && defined $_->id ?
- ($_) : @{[]} } map { $urpm->{depslist}[$_] }
+ $_ : @{[]} } map { $urpm->{depslist}[$_] }
keys %{$urpm->{provides}{$v} || {}}) {
#- we assume that if the there is at least one package providing the resource exactly,
#- this should be the best ones that is described.
#- but we first check if one of the packages has the same name as searched.
- if (my @l2 = grep { $_->name eq $v} @l) {
+ if (my @l2 = grep { $_->name eq $v } @l) {
$exact{$v} = join '|', map { $_->id } @l2;
} else {
$exact{$v} = join '|', map { $_->id } @l;
@@ -2571,7 +2571,7 @@ sub get_source_packages {
#- examine the local repository, which is trusted (no gpg or pgp signature check but md5 is now done).
opendir D, "$urpm->{cachedir}/rpms";
while (defined($_ = readdir D)) {
- if (my ($filename) = /^([^\/]*\.rpm)$/) {
+ if (my ($filename) = m|^([^/]*\.rpm)$|) {
my $filepath = "$urpm->{cachedir}/rpms/$filename";
if (!$options{clean_all} && -s $filepath) {
if (keys(%{$file2fullnames{$filename} || {}}) > 1) {
@@ -2608,7 +2608,7 @@ sub get_source_packages {
#- always prefer a list file is available.
my $file = $medium->{list} && "$urpm->{statedir}/$medium->{list}";
if (!$file && $medium->{virtual}) {
- my ($dir) = $medium->{url} =~ /^(?:removable[^:]*|file)?:\/(.*)/;
+ my ($dir) = $medium->{url} =~ m!^(?:removable[^:]*|file)?:/(.*)!;
my $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/.."));
my $local_list = $medium->{with_hdlist} =~ /hd(list.*)\.cz2?$/ ? $1 : 'list';
$file = reduce_pathname("$with_hdlist_dir/../$local_list");
@@ -2617,7 +2617,7 @@ sub get_source_packages {
if (-r $file) {
open F, $file;
while (<F>) {
- if (my ($filename) = /\/([^\/]*\.rpm)$/) {
+ if (my ($filename) = m|/([^/]*\.rpm)$|) {
if (keys(%{$file2fullnames{$filename} || {}}) > 1) {
$urpm->{error}(N("there are multiple packages with the same rpm filename \"%s\""), $filename);
next;
@@ -2797,7 +2797,7 @@ sub copy_packages_of_removable_media {
if (!$dir || -e $dir) {
foreach (values %{$list->[$id]}) {
chomp;
- /^(removable_?[^_:]*|file):\/(.*\/([^\/]*))/ or next;
+ m!^(removable_?[^_:]*|file):/(.*/([^/]*))! or next;
unless ($dir) {
$dir = $2;
$urpm->try_mounting($dir, $removable);
@@ -2814,7 +2814,7 @@ sub copy_packages_of_removable_media {
my $examine_removable_medium = sub {
my ($id, $device, $copy) = @_;
my $medium = $urpm->{media}[$id];
- if (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
+ if (my ($prefix, $dir) = $medium->{url} =~ m!^(removable[^:]*|file):/(.*)!) {
#- the directory given does not exist or may be accessible
#- by mounting some other. try to figure out these directory and
#- mount everything necessary.
@@ -2827,7 +2827,7 @@ sub copy_packages_of_removable_media {
if (-e $dir) {
while (my ($i, $url) = each %{$list->[$id]}) {
chomp $url;
- my ($filepath, $filename) = $url =~ /^(?:removable[^:]*|file):\/(.*\/([^\/]*))/ or next;
+ my ($filepath, $filename) = $url =~ m!^(?:removable[^:]*|file):/(.*/([^/]*))! or next;
if (-r $filepath) {
if ($copy) {
#- we should assume a possible buggy removable device...
@@ -2866,7 +2866,7 @@ sub copy_packages_of_removable_media {
#- examine non removable device but that may be mounted.
if ($medium->{removable}) {
push @{$removables{$medium->{removable}} ||= []}, $_;
- } elsif (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
+ } elsif (my ($prefix, $dir) = $medium->{url} =~ m!^(removable[^:]*|file):/(.*)!) {
chomp $dir;
-e $dir || $urpm->try_mounting($dir) or
$urpm->{error}(N("unable to access medium \"%s\"", $medium->{name})), next;
@@ -2917,13 +2917,13 @@ sub download_packages_of_distant_media {
while (my ($i, $url) = each %{$list->[$_]}) {
#- it is trusted that the url given is acceptable, so the file can safely be ignored.
defined $sources->{$i} and next;
- if ($url =~ /^(removable[^:]*|file):\/(.*\.rpm)$/) {
+ if ($url =~ m!^(removable[^:]*|file):/(.*\.rpm)$!) {
if (-r $2) {
$sources->{$i} = $2;
} else {
$error_sources->{$i} = $2;
}
- } elsif ($url =~ /^([^:]*):\/(.*\/([^\/]*\.rpm))$/) {
+ } elsif ($url =~ m|^([^:]*):/(.*/([^/]*\.rpm))$|) {
if ($options{force_local} || $1 ne 'ftp' && $1 ne 'http') { #- only ftp and http protocol supported by grpmi.
$distant_sources{$i} = "$1:/$2";
} else {
@@ -2956,7 +2956,7 @@ sub download_packages_of_distant_media {
#- necessary to keep track of failing download in order to
#- present the error to the user.
foreach my $i (keys %distant_sources) {
- my ($filename) = $distant_sources{$i} =~ /\/([^\/]*\.rpm)$/;
+ my ($filename) = $distant_sources{$i} =~ m|/([^/]*\.rpm)$|;
if ($filename && -s "$urpm->{cachedir}/partial/$filename" &&
URPM::verify_rpm("$urpm->{cachedir}/partial/$filename", nosignatures => 1) !~ /NOT OK/) {
#- it seems the the file has been downloaded correctly and has been checked to be valid.
@@ -2973,7 +2973,7 @@ sub download_packages_of_distant_media {
}
#- clean failed download which have succeeded.
- delete @{$error_sources}{keys %$sources};
+ delete @$error_sources{keys %$sources};
1;
}
@@ -3043,7 +3043,7 @@ sub install {
local (*CHILD_RETURNS, *ERROR_OUTPUT, $_);
if ($options{fork}) {
pipe(CHILD_RETURNS, ERROR_OUTPUT);
- if ($pid = fork) {
+ if ($pid = fork()) {
close ERROR_OUTPUT;
$urpm->{log}(N("using process %d for executing transaction"));
@@ -3051,7 +3051,7 @@ sub install {
my @l;
while (<CHILD_RETURNS>) {
chomp;
- if (/^\::logger_id:(\d+)/) {
+ if (/^::logger_id:(\d+)/) {
$urpm->{logger_id} = $1;
} else {
push @l, $_;
@@ -3079,7 +3079,7 @@ sub install {
$urpm->{log}(N("created transaction for installing on %s (remove=%d, install=%d, upgrade=%d)", $urpm->{root} || '/',
scalar(@{$remove || []}), scalar(values %$install), scalar(values %$upgrade)));
} else {
- return (N("unable to create transaction"));
+ return N("unable to create transaction");
}
my ($update, @l, %file2pkg) = 0;
@@ -3245,11 +3245,11 @@ sub find_packages_to_remove {
});
if (!$options{force} && @notfound) {
- unless (@m) {
- $options{callback_notfound} and $options{callback_notfound}->($urpm, @notfound)
+ if (@m) {
+ $options{callback_fuzzy} and $options{callback_fuzzy}->($urpm, $match, @m)
or return ();
} else {
- $options{callback_fuzzy} and $options{callback_fuzzy}->($urpm, $match, @m)
+ $options{callback_notfound} and $options{callback_notfound}->($urpm, @notfound)
or return ();
}
}
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-16 00:53:58 +0000