\s*@@si ||
error ("unable to trim head in $url");
s@\s*(<[^<>]+>\s*)*Tomorrow\'s picture:.*?$@@ ||
error ("unable to trim tail in $url");
s@^(\s*<[^<>]+>\s*)+@@s; # lose leading tags
s@^\s*((\d{4})[- ]([a-z]+)[- ](\d\d?))\b\s*(<(BR|P)>\s*)*@@i ||
error ("$url: unable to find date");
my $date = $1;
my $year = $2;
my $month = $3;
my $dotm = $4;
s@]*>\s*@@gsi; # lose table tags
s@@
@gsi;
s@( ]*> \s* ]*> \s* \s* ) ( .* )$@
$1
$2
@six;
s/[\r\n]+/ /gs;
s/\s+/ /gs;
my $body = $_;
my %m = ( "Jan" => 1, "Feb" => 2, "Mar" => 3, "Apr" => 4,
"May" => 5, "Jun" => 6, "Jul" => 7, "Aug" => 8,
"Sep" => 9, "Oct" => 10, "Nov" => 11, "Dec" => 12);
$month =~ s/^(...).*/$1/;
$month = $m{$month} || error ("unparsable month: $month");
my $eurl = $url . sprintf ("ap%02d%02d%02d.html",
$year % 100, $month, $dotm);
s@<(P|BR)\b[^<>]*>@\n@gsi; # expand newlines
s@<[^<>]*>@@g; # lose other tags
my ($title) = m@^\s*(.*?)\s*$@m;
return ($eurl, $date, $title, $body);
}
sub do_redmeat($$) {
my ($url, $html) = @_;
$url =~ s@/[^/]*$@/@; # take off last path component
$_ = $html;
1 while (s@@ @gsi); # lose comments
s@[\r\n]+@ @gs;
s@^.*?(]*\bHREF=\"([^\"]+)\"[^<>]*>(.*?).*$@@i
|| error ("unparsable entry in $url");
my $eurl = $1;
my $title = $2;
$_ = $eurl;
my ($date) = m@\b(\d{4}-\d{2}-\d{2})\b@;
$date = '' unless $date;
$eurl =~ s@/index\.html?$@/@i;
my $rbody = ("
" .
"" .
"
");
my $body = "$rbody";
push @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
sub do_space_com($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
1 while (s@]*>.*?]*>@@gsi); # lose javascript
s@[\r\n]+@ @gs;
s@(]*>@@gsi;
m@^.*]*\bHREF=\"([^\"]+)\"[^<>]*>@i
|| error ("unparsable entry (url) in $url");
my $eurl = $1;
m@^.*]*\bSRC=\"([^\"]+)\"[^<>]*>@i
|| error ("unparsable entry (image) in $url");
my $img = $1;
next if ($eurl =~ m@(/navigation|/template|doubleclick)@i);
next if ($img =~ m@(/navigation|/template|doubleclick)@i);
# now let's munge the HTML a little...
s@(]*>@@igs;
$_ .= " ";
s@>>+@>>@gsi; # dummies
my $body = $_;
my $date = ''; # note: could parse this from $eurl pathname
s@<(BR|P)\b[^<>]*>@\n@gsi; # put newlines back
s@<[^<>]*>@@gs; # lose all tags
s@\n.*$@@s; # delete all but first line
my $title = $_;
next if ($eurl =~ m/\bads\.space\.com/i);
push @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
# generate a single-entry RSS file with an inline image of the latest cartoon.
#
sub do_catandgirl_inline($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s/[\r\n]+/ /gs;
s@(<(A|IMG)\b)@\n$1@gsi;
my $number = 0;
my ($eurl, $title, $body);
foreach (split (/\n/)) {
if (m@^]*\bHREF=\"(view\.(cgi|php)\?)(loc=)?(\d+)\"@i) {
my $base = $1;
my $n = $4;
if ($n > $number) {
$number = $n + 1;
$eurl = $base . $number;
}
} elsif (m@^]*\bSRC=\"([^<>\"]+)\"[^<>]*\bALT=\"([^<>\"]+)\"@i) {
my ($img, $alt) = ($1, $2);
s/>.*$/>/s;
if ($img =~ m@\barchive/@) {
$body = $_;
$title = $alt;
}
}
}
error ("couldn't find image number? ($number) in $url")
unless ($number > 123);
error ("couldn't find image in $url") unless (defined ($body));
my $date = '';
return ($eurl, $date, $title, $body);
}
sub do_geisha_asobi($$) {
my ($url, $html) = @_;
$_ = $html;
s@\r\n@\n@gs;
s@\r@\n@gs;
s@^.*@@is ||
error ("unable to trim head in $url");
s@.*$@@is ||
error ("unable to trim tail in $url");
s@^.*?()@$1@is ||
error ("unable to trim head-2 in $url");
s@(\s*$1@gsi; # make start/end differ
s@.*?@@gis;
s@\s+@ @gs; # lose newlines, compress whitespace
s@]*>@\n@gsi;
my @sec = ();
foreach (split ('\n', $_)) {
next if (m/^\s*$/s);
s@]*>@@gsi; # lose fonts
s@(]*?)\s*\bTARGET=\"?[^<>\"]+\"@$1@gsi; # lose TARGETs in A
s/\s+/ /gs;
s/^\s+//gs;
s/\s+$//gs;
my $body = $_;
m@\bposted by .* (on|at)\s+\"]+)\">([^<>]+)@i ||
error ("unparsable time in $url");
my ($eurl, $date) = ($2, $3);
$date =~ s/\s+$//g;
$date =~ s/^\s+//g;
# try for a title on the first line
my $title = $body;
$title =~ s@<(BR|P|IMG)\b[^<>]*>@\n@gsi;
$title =~ s@]*>@ @gs;
$title =~ s@^[ \t]*@@;
$title =~ s@[ \t]*$@@;
$title =~ s@\n.*$@@s;
$title =~ s@\s+$@@s;
push @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
sub do_penn($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s/\s+/ /gs;
s@@@gi; # bogosity
s/(])/\n$1/gi;
s@( 0 && m@\"]+)\"@i;
error ("unable to find url: $url") unless ($eurl);
$_ =~ s@<[^<>]+>@@g;
my ($title, $date) = m@^(.+)(\d\d?[\s/]+\d\d?[\s/]+\d+)[^a-z\d]+$@;
error ("unable to find title: $url $_") unless ($title);
error ("unable to find date: $url") unless ($date);
$title =~ s@^\s+@@s;
$title =~ s@[^a-z]+$@@s;
$date =~ s@^\s+@@s;
$date =~ s@\s+$@@s;
my $body = "$title ($date)";
push @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
sub do_gywo($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s/\s+/ /gs;
s/(])/\n$1/gi;
s@(\"]+)\"@i;
next unless ($eurl && $eurl =~ m/\bwar(\d+)\.html$/);
my $n = $1;
my $title = "get your war on page $n";
my $date = "";
my $body = "$title";
unshift @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
sub do_slashdot($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s/\s+/ /gs;
s/(
)/\n$1/gsi;
s/^[^\n]*\n//si; # lose head
s/\n[^\n]*$//si; # lose tail
my @sec = ();
foreach (split (/\n/)) {
s@.*?
@@si;
s@.*?@@si;
my ($title) = m@(.*?)@si;
my ($body) = m@(.*?)@si;
next unless defined ($title);
$_ = $title;
s@]+/?\"[^<>]*>.*?@@si; # lose first one
my ($eurl) = m@\"]+)\"@si;
error ("unable to find entry URL in $url") unless defined ($eurl);
$title =~ s@<[^<>]*>@@gs;
$body =~ s@
@@gsi;
$body =~ s@]*>@ @gsi;
$title =~ s/\s+/ /gsi;
$body =~ s/\s+/ /gsi;
$title =~ s/(^\s+|\s+$)//gsi;
$body =~ s/(^\s+|\s+$)//gsi;
1 while ($body =~ s@\s*]*>\s*$@@gsi);
my $date = '';
push @sec, ($eurl, $date, $title, $body);
}
return @sec;
}
sub do_linkfilter($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s@ @ @gs;
s@\s+@ @gsi;
s@\s*(]*?\bCLASS=\"td-head\">)\s*@\n$1@gsi;
my @sec1 = split (/\n/);
my @sec2 = ();
shift @sec1;
foreach (@sec1) {
next if (m/^\s*$/s);
s@^\s*]*>\s*@@si || error ("no TD in entry in $url");
s@^\s*]*?\bHREF=\"([^<>\"]+)\"[^<>]*>\s*(.*?)\s*@@is ||
error ("unparsable entry (anchor) in $url");
my $eurl = $1;
my $title = $2;
$eurl =~ s@;cmd=go$@@; # bah.
s@(]*>@$1P>@gsi; # fuck SPAN
# lose the category and submitter links
s@]*>.*?\s*@@gsi;
# lose leading P, BR, and DIV
1 while (s@^\s*]*>\s*@@is);
# compact
s@(]*>\s*)+@
@gsi;
my ($date) = m@submitted(.*?) @si;
s@^Link\b(.*?) \s*@@gsi || error ("no date line in $url");
$date =~ s@^.* on @@;
$date =~ s@\s*\.?\s*\(.*$@@;
s@\s+\bONCLICK=\"[^\"]+\"@@gsi;
# you chumps. undo link-tracking BS.
s@]*>\s*(http:[^<>\"]+)\s*\s*@@si;
my $turl = $1;
my $oturl = $turl;
error ("no url found in $url") unless defined ($turl);
# FUCK! assholes! we have to use their redirector if the link was
# long, because they truncate it.
if ($turl =~ m/\.\.\.$/) {
$turl = "$eurl;cmd=go";
}
# lose trailing Comments links
s@]*>\s*Comments\b.*$@@si;
# lose trailing P, BR, and DIV
1 while (s@\s*]*>\s*$@@is);
my $body = $_;
$body = "$oturl
$body";
push @sec2, ($eurl, $date, $title, $body);
}
return @sec2;
}
sub do_creaturesinmyhead($$) {
my ($url, $html) = @_;
$_ = $html;
1 while (s@@ @gsi); # lose comments
s@ @ @gs;
s@\s+@ @gsi;
my ($img, $title) = m@(]*>)
\s* (.*?)
@xsi;
error ("no image in $url") unless defined ($img);
$img =~ s/\s+ALT\s*=\s*\"[^<>\"]*\"\s*/ /gsi;
$title =~ s@<[^<>]*>@ @gsi;
$title =~ s@\s+@ @g;
$title =~ s@^\s+@@g;
$title =~ s@\s+$@@g;
my ($date) = ($img =~ m@creatures/(\d{6})[^\d]@);
error ("no date in $img") unless defined ($date);
my $eurl = "/creature.php?date=$date";
$date =~ s@^(\d\d)(\d\d)(\d\d)$@$1/$2/$3@;
$title =~ s@^[-\s\d/]+:\s*@@gs;
my $body = "
![](\"$eurl/index-1.gif\")
" .
"![](\"/images/topics/[^<)