strip.pl

   1 #!/usr/bin/perl
   2 # Copyright (C) 2003, 2004, 2008  Alex Schroeder <alex@gnu.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program. If not, see <http://www.gnu.org/licenses/>.
  16
  17 use CGI qw/:standard/;
  18 use CGI::Carp qw(fatalsToBrowser);
  19 use LWP::UserAgent;
  20 use Encode;
  21 use HTML::Parser;
  22
  23 if (not param('url')) {
  24   print header(),
  25     start_html('Link Stripping'),
  26     h1('Link Stripping'),
  27     p('Transforms HTML into a plain-text list of link texts, one link per line.',
  28       'For example, the HTML &lt;a href="foo.html">bar&lt;/a> will be transformed to',
  29       'the text "bar".'),
  30     start_form(-method=>'GET'),
  31     p('HTML feed: ', textfield('url', '', 40), checkbox('latin-1'), submit()),
  32     end_form(),
  33     end_html();
  34   exit;
  35 }
  36
  37 print header(-type=>'text/plain; charset=UTF-8');
  38 $ua = LWP::UserAgent->new;
  39 $request = HTTP::Request->new('GET', param('url'));
  40 $response = $ua->request($request);
  41 $data = $response->content;
  42 $data = encode('utf-8', decode('latin-1', $data)) if param('latin-1');
  43 $p = HTML::Parser->new(api_version => 3);
  44 $p->handler( start => \&start_handler, "tagname,self");
  45 %pages = ();
  46 $p->parse($data);
  47 $p->eof;                 # signal end of document
  48 print join("\n", sort keys %pages), "\n";
  49
  50 sub start_handler {
  51   return if shift ne "a";
  52   my $self = shift;
  53   $self->handler(text => sub { $pages{(shift)} = 1 }, "dtext");
  54   $self->handler(end  => sub { $self->handler(text => ""); });
  55 }