#!/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
_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_";
$chname $chdesc
_HTML_
for my $item (@{$rss->{'items'}}) {
my $itemlink = $item->{'link'};
my $itemlink_enc = uri_escape($itemlink);
my $itemname = &encode($item->{'title'});
my $itemdesc = &encode($item->{'description'});
$html .= <<"_HTML_";
$itemname $itemdesc» Trace further...
_HTML_
}
$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/&/&/g;
$str =~ s/</</g;
$str =~ s/>/>/g;
$str =~ s/"/"/g;
$str =~ s/&#(\d+);/$1;/g;
$str =~ s/</g;
$str =~ s/>/>/g;
$str =~ s/"/"/g;
$str =~ s/'/'/g;
return $str;
}