#!/usr/bin/perl -wT # inet-news.pl - build a top news listing for www.internetnews.com # by Jonathan Eisenzopf. v1.0 990214 # Copyright (c) 1999 internet.com LLC. All Rights Reserved. # Originally published and documented at http://www.webreference.com # You may use this code on a Web site only if this entire # copyright notice appears unchanged and you publicly display # on the Web site a link to http://www.webreference.com/perl/. # # Contact eisen@internet.com for all other uses. use strict; use CGI; use HTTP::Request; use LWP::UserAgent; my ($key,$attr,%h_attr,$text,@entities,$content); my $entity = ""; my $query = new CGI; print $query->header; &printError("You must complete both fields!") unless ($query->param('url') && $query->param('fields')); my $ua = new LWP::UserAgent; $ua->agent("xml-fetch/1.0"); $ua->max_size([1000000]); my $request = new HTTP::Request GET => $query->param('url'); my $response = $ua->request($request); &printError($response->code.": Error retrieving URL ".$query->param('url')) unless ($response->is_success); @entities = split(/,/,$query->param('fields')); $content = $response->content; &Print_Header; foreach $entity (@entities) { while ($content =~ /<$entity\s*(.*?)(\/>|>(.*?)<\/$entity>)/gsi) { ($text,%h_attr) = ""; my @attribs = split(/"\s+/,$1); foreach $attr (@attribs) { next if !$attr; my ($key,$value) = split(/=/,$attr); $value =~ s/\"//g; $h_attr{$key} = $value; } &Print_Element(\%h_attr); } } print "\n"; # End of main code # Functions sub printError { my $message = shift; print < xml-fetch ERROR

xml-fetch ERROR

$message HTML exit; } sub Print_Header { print "www.internetnews.com Top Headlines\n"; print "

www.internetnews.com Top Headlines

\n"; print "URL: ",$query->param('url'),"

\n"; print < Headlines HTML } sub Print_Element { my $hash = shift; print <$hash->{'text'} HTML }