Хитрость заключается в том, чтобы выяснить, как вы хотите печатать красивые URL-адреса каждого типа, поэтому в этом случае вам нужно указать сценарию, что делать в каждом случае:
use URI;
while( <DATA> ) {
chomp;
my $uri = URI->new( $_ );
my $s = $uri->scheme;
my $rest = do {
if( $s =~ /(?:https?|ftp)/ ) {
$uri->host . $uri->path_query
}
elsif( $s eq 'mailto' ) {
$uri->path
}
elsif( ! $s ) {
$uri
}
};
print "$uri -> $rest\n";
}
__END__
http://www.example.com/foo/bar.html
www.example.com/foo/bar.html
ftp://www.example.com
mailto:joe@example.com
https://www.example.com/foo?a=b;c=d
http://joe:password@www.example.com/login
Это приводит к:
http://www.example.com/foo/bar.html -> www.example.com/foo/bar.html
www.example.com/foo/bar.html -> www.example.com/foo/bar.html
ftp://www.example.com -> www.example.com
mailto:joe@example.com -> joe@example.com
https://www.example.com/foo?a=b;c=d -> www.example.com/foo?a=b;c=d
http://joe:password@www.example.com/login -> www.example.com/login
Если вы хотите что-то другое для определенного URL, вам просто нужно создать для него ветку и собрать нужные вам части.Обратите внимание, что URI также обрабатывает URI без схемы.
Если вам не нужны длинные строки URI для красивой печати, вы можете добавить что-то подобное, чтобы обрезать строку после стольких символов:
substr( $rest, 20 ) = '...' if length $rest > 20;
Вот решение с given, которое немного чище, но немного уродливее.Это версия Perl 5.010:
use 5.010;
use URI;
while( <DATA> ) {
chomp;
my $uri = URI->new( $_ );
my $r;
given( $uri->scheme ) {
when( /(?:https?|ftp)/ ) { $r = $uri->host . $uri->path_query }
when( 'mailto' ) { $r = $uri->path }
default { $r = $uri }
}
print "$uri -> $r\n";
}
Это уродливее, потому что я должен повторить это назначение $r.Perl 5.14 исправит это, хотя и разрешит given возвращаемому значению.Поскольку эта стабильная версия еще не доступна, вы должны использовать экспериментальную дорожку 5.13:
use 5.013004;
use URI;
while( <DATA> ) {
chomp;
my $uri = URI->new( $_ );
my $r = do {
given( $uri->scheme ) {
when( /(?:https?|ftp)/ ) { $uri->host . $uri->path_query }
when( 'mailto' ) { $uri->path }
default { $uri }
}
};
print "$uri -> $r\n";
}