From 21f4f7adc6ee28d6599ea7647d789cd6de59d0a4 Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Thu, 22 Apr 2004 10:42:52 +0000 Subject: More refactorization. Some silencing of the warnings emitted by -w. --- urpm/util.pm | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) create mode 100644 urpm/util.pm (limited to 'urpm/util.pm') diff --git a/urpm/util.pm b/urpm/util.pm new file mode 100644 index 00000000..cbfcb06b --- /dev/null +++ b/urpm/util.pm @@ -0,0 +1,74 @@ +package urpm::util; + +use strict; +use Exporter; +our @ISA = 'Exporter'; +our @EXPORT = qw(quotespace unquotespace + remove_internal_name + reduce_pathname offset_pathname); + +#- quoting/unquoting a string that may be containing space chars. +sub quotespace { my $x = $_[0] || ''; $x =~ s/(\s)/\\$1/g; $x } +sub unquotespace { my $x = $_[0] || ''; $x =~ s/\\(\s)/$1/g; $x } +sub remove_internal_name { my $x = $_[0] || ''; $x =~ s/\(\S+\)$/$1/g; $x } + +#- reduce pathname by removing /.. each time it appears (or . too). +sub reduce_pathname { + my ($url) = @_; + + #- 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 =~ m|([^:/]*://[^/]*/)?(.*)|; + + #- remove any multiple /s or trailing /. + #- then split all components of pathname. + $dir =~ s|/+|/|g; $dir =~ s|/$||; + my @paths = split '/', $dir; + + #- reset $dir, recompose it, and clean trailing / added by algorithm. + $dir = ''; + foreach (@paths) { + if ($_ eq '..') { + if ($dir =~ s|([^/]+)/$||) { + if ($1 eq '..') { + $dir .= "../../"; + } + } else { + $dir .= "../"; + } + } elsif ($_ ne '.') { + $dir .= "$_/"; + } + } + $dir =~ s|/$||; + $dir ||= '/'; + + $host . $dir; +} + +#- offset pathname by returning the right things to add to a relative directory +#- to make no change. url is needed to resolve going before to top base. +sub offset_pathname { + my ($url, $offset) = map { 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 (undef, $dir) = $url =~ m|([^:/]*://[^/]*/)?(.*)|; + my @paths = split '/', $dir; + my @offpaths = reverse split '/', $offset; + my @corrections; + my $result = ''; + + foreach (@offpaths) { + if ($_ eq '..') { + push @corrections, pop @paths; + } else { + $result .= '../'; + } + } + $result . join('/', reverse @corrections); +} + +1; + +__END__ -- cgit v1.2.1