如何在Perl中很好地格式化url?

诀窍在于弄清楚如何漂亮地打印每种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字符串,您可以在这么多字符之后插入类似的内容来切断字符串:

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 . Perl5.14将解决这个问题,尽管 鉴于 有一个返回值。由于该稳定版本尚未推出,因此您必须使用实验性的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";
    }

RFC 2396 指定解析URI引用的正则表达式。稍微调整一下以得到你想要的:

#! /usr/bin/perl

use warnings;
use strict;

use 5.10.0;  # for defined-or (//)

my $uri = qr{
  ^
  (?:([^:/?\#]+):)?  # scheme = $1
  (?://([^/?\#]*))?  # authority = $2
  ([^?\#]*)          # path = $3
  (\?[^\#]*)?        # query = $4
  (\#.*)?            # fragment = $5
}x;

上面的代码使用 /x modifier

它告诉正则表达式解析器忽略大多数既不是反斜杠也不是字符类中的空白。可以使用它将正则表达式分解为(稍微)更可读的部分。这个 # 字符也被视为引入注释的元字符,就像在普通Perl代码中一样。

# 字符,这意味着我需要用反斜杠来摆脱它们。出于习惯,我从 qr/ 但由于模式中的斜杠,必须更改分隔符。

一些测试用例:

my @cases = qw(
  ftp://www.foo.com.invalid/
  http://www.foo.com.invalid/
  http://www.foo.com.invalid/long_path
  http://www.foo.com.invalid/?query
  http://www.foo.com.invalid?query
  http://www.foo.com.invalid/#fragment
  http://www.foo.com.invalid#fragment
);

一点逻辑

for (@cases) {
  my $nice;
  if (my($scheme,$auth,$path,@rest) = /$uri/) {
    if ($scheme eq "http" && defined $auth) {
      if (grep defined, @rest) {
        $nice = join "" => map $_ // "" => $auth, $path, @rest;
      }
      else {
        $nice = $auth
              . ($path eq "/" ? "" : $path);
      }
    }
    else {
      $nice = $_;
    }
  }

  print "$_ → $nice\n";
}

以及输出:

ftp://www.foo.com.invalid/ → ftp://www.foo.com.invalid/
http://www.foo.com.invalid/ → www.foo.com.invalid
http://www.foo.com.invalid/long_path → www.foo.com.invalid/long_path
http://www.foo.com.invalid/?query → www.foo.com.invalid/?query
http://www.foo.com.invalid?query → www.foo.com.invalid?query
http://www.foo.com.invalid/#fragment → www.foo.com.invalid/#fragment
http://www.foo.com.invalid#fragment → www.foo.com.invalid#fragment

尝试 the URI module 来自cpan。

我不太清楚你到底想要什么。我猜你想脱光衣服 http://

#!/usr/bin/perl
use strict;
use warnings;
use 5.10.1;


my @url_list = ('http://www.foo.com/','http://www.foo.com/long_path');

for my $url (@url_list) {
    (my $short = $url) =~ s!\w+://!!;
    $short =~ s!/$!!;
    $short =~ s!^(.{15}).*$!$1...!;
    say "<a href='$url'>$short</a>";
}

输出:

<a href='http://www.foo.com/'>www.foo.com</a>
<a href='http://www.foo.com/long_path'>www.foo.com/lon...</a>

#!/usr/bin/perl -w

use strict;

my @url_list = ("<a href=http://www.test.com>www.test.com</a>",
                "<a href=http://www.example.com>www.example.com</a&gt",
                "<a href=http://www.this.com>www.this.com</a&gt");

my ($protocol, $domain_name);

foreach my $url (@url_list) {
    $url =~ m|(\w+)://([^/:]+)(:\d+)?/(.*)|;
    $protocol = $1;
    $domain_name = $2;
    my ($url_part, $name_part) = split(/>/, $domain_name);
    $name_part =~ s/\<//g;
    print $protocol, "://" ,$url_part, " -> ", $name_part  , "\n";
}

< 在域名中取了一个替代来删除。要回答您最初的问题,您可以将 LWP::Simple 和 HTML::LinkExtor 从web下载和解析HTML文档。强大的组合。

**免责声明:由于Ruby和Python,我的Perl很糟糕。为残暴地使用你的语言向纯粹主义者道歉。