#!/usr/local/bin/perl use strict; use CGI; use Jcode; use LWP::Simple; use URI::Escape; use XML::RSS; my $q = new CGI; my $j = new Jcode; my $target = $q->param('target'); my $target_dec = uri_unescape($target); my $html = <<"_HTML_"; TrackBack Tracer

TrackBack Tracer



_HTML_ if ($q->param('target')) { $target = &discover_tb($target); $target .= "?__mode=rss"; my $content = get($target); $content =~ s!.*?!!s; $content =~ s!!!; $content = $j->set(\$content)->utf8; $content =~ s/<\?xml.*?\?>/<\?xml version="1.0" encoding="UTF-8"\?>/; my $rss = new XML::RSS; eval { $rss->parse($content); }; if (!$@) { my $chlink = $rss->{'channel'}->{'link'}; my $chname = &encode($rss->{'channel'}->{'title'}); my $chdesc = &encode($rss->{'channel'}->{'description'}); $html .= <<"_HTML_";
_HTML_ } else { $html .= qq!

Error: $@

\n
\n!; } } $html .= <<"_HTML_";
Copyrights © 2003 Kyo Nagashima. All Rights Reserved.
_HTML_ print <<"_HTML_"; Content-Type: text/html; charset=UTF-8 $html _HTML_ exit; sub discover_tb { my $url = $_[0]; my $c = get($url); (my $url_no_anchor = $url) =~ s/#.*$//; my $item; while ($c =~ m!()!sg) { my $rdf = $1; my($perm_url) = $rdf =~ m!dc:identifier="([^"]+)"!; next unless $perm_url eq $url || $perm_url eq $url_no_anchor; if ($rdf =~ m!trackback:ping="([^"]+)"!) { return $1; } elsif ($rdf =~ m!about="([^"]+)"!) { return $1; } } } sub encode { my $str = $_[0]; $str =~ s/\x0D|\x0A//g; $str =~ s/\t//g; $str =~ s/^\s*//; $str =~ s/\s*$//; $str =~ s/&/&/g; $str =~ s/&amp;/&/g; $str =~ s/&lt;/</g; $str =~ s/&gt;/>/g; $str =~ s/&quot;/"/g; $str =~ s/&#(\d+);/&#$1;/g; $str =~ s//>/g; $str =~ s/"/"/g; $str =~ s/'/'/g; return $str; }