#!/usr/bin/perl -W # TP protocole HTTP # # Question 3 # # Antoine Miné # 20/04/2007 # url_cat(base,lien) concatène lien à base sub url_cat { my $base = shift; my $lien = shift; # découpe $base my ($protocole, $serveur, $page) = $base =~ /^([a-z]+):\/\/([a-z0-9.:-]+)(\/.*)$/; # supprime ce qui suit le dernier / dans $page ($page) = $page =~ /^(.*\/)[^\/]*$/; # supprime le suffixe en # de $lien ($lien) = $lien =~ /^([^#]*)/; # cas où $lien est une URL complète return $lien if $lien =~ /^[a-zA-Z]+:/; # cas où $lien précise le serveur et le chemin absolu return "$protocole:$lien" if $lien =~ /^\/\//; # cas où $lien précise juste le chemin absolu return "$protocole://$serveur$lien" if $lien =~ /^\//; # cas où $lien est un chemin relatif $lien = "$page/$lien"; # remplace tous les // par / while ($lien =~ s/\/\//\//g) {} # remplace les /xxxx/.. par rien (de gauche à droite) while ($lien =~ s/\/[^\/]*\/\.\.//) {} # remplace tous les /. par rien while ($lien =~ s/\/\.//g) {} return "$protocole://$serveur$lien"; } # programme de test $base = $ARGV[0]; $liens = $ARGV[1] || die "utilisation: $0 base liens"; $res = url_cat($base,$liens); print "$res\n";