diff options
| -rw-r--r-- | urpm.pm | 134 |
1 files changed, 67 insertions, 67 deletions
@@ -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 (); } } |