虎虎's 博客

use LWP::UserAgent;
sub discover_tb {
    my $url = shift;
    my $ua = LWP::UserAgent->new;
    $ua->agent('TrackBack/1.0');  
    $ua->parse_head(0);   ## So we don't need HTML::HeadParser
    $ua->timeout(15);
    ## 1. Send a GET request to retrieve the page contents.
    my $req = HTTP::Request->new(GET => $url);
    my $res = $ua->request($req);
    return unless $res->is_success;
    ## 2. Scan te page contents for embedded RDF.
    my $c = $res->content;
    (my $url_no_anchor = $url) =~ s/#.*$//;
    my $item;
    while ($c =~ m!(<rdf:RDF.*?</rdf:RDF>)!sg) {
        my $rdf = ;
        my($perm_url) = $rdf =~ m!dc:identifier="([^"]+)"!;  
        next unless $perm_url eq $url || $perm_url eq $url_no_anchor;
        ## 3. Extract the trackback:ping value from the RDF.
        ## We look for 'trackback:ping', but fall back to 'about'
        if ($rdf =~ m!trackback:ping="([^"]+)"!) {
            return ;
        } elsif ($rdf =~ m!about="([^"]+)"!) {
            return ;
        }
    }
}

这段Perl定义了一个过程 discover_tb. 给定一个 URL, 它会试图找到与此URL相对应的TrackBack Ping URL. 如果找到了，它会返回 TrackBack Ping URL; 否则返回 undef.