CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Need a Custom or Prewritten Perl Program?: I need a program that...:
Web Service Test Script (moreover.com)

 



mozkill
Novice

May 8, 2002, 8:58 AM

Post #1 of 2 (1533 views)
Web Service Test Script (moreover.com) Can't Post

this script takes a list of URI addresses as arguments, appends the domain suffix you entered as a script argument, and tests each complete URL and prints a status code to console. also each XML response packet is parsed and printed to a file in the out directory where the script is ran from. this script supports packet responses that are not XML. also, you need to edit the XML sections to comply with the web service XML tagname definitions.

this is a debug version of the script that basically prints out an HTML version of the XML returned from the site. you can change the debug output as you wish.

this script is currently configured to parse results from http://w.moreover.com/categories/category_list_xml.html .

**************************
# include package
use strict;
use XML::Parser;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;

#-----------------------------------------------------------------
# White box WWW test script with XML support.
#-----------------------------------------------------------------

my $code;
my $dstring;
my $server = "http://p.moreover.com";

#-----------------------------------------------------------------
# the rows of the urls array (below) are formatted as [text
# description, text URI, boolean: use XML parser]
#
# urls from http://w.moreover.com/categories/category_list_xml.html
#
#-----------------------------------------------------------------
my @urls = (
["baseball", "/cgi-local/page?c=Sports%3A%20baseball%20news&o=xml", 1, "GET"],
["basketball", "/cgi-local/page?c=Sports%3A%20basketball%20news&o=xml", 1, "GET"]
);

foreach my $p_row (@urls) {
print "--------------------------------\n";
my $key = $p_row->[0];
$code = testURL( $server, (@{$p_row})[0..3] );
print "$key Code: $code\n";
}
print "--------------------------------\n";


#-----------------------------------------------------------
# testURL() - fires URL at server, gets response code and
# content (which can be saved for examination)
#-----------------------------------------------------------
sub testURL {

my($server,$tag,$url,$pxml,$type) = @_;

# replace function that massages the URL before it is checked
$url =~ s/idvalue/$siteid/;
print $type." ".$url;

my $ua = LWP::UserAgent->new();
my $srv = "http://$server".$url;
my $req = HTTP::Request->new($type => $server.$url);
$req->header("Accept" => "*/*",
"Accept-Language" => "en-us",
"Accept-Encoding" => "gzip, deflate",
"User-Agent" => "Mozilla/8.0",
"Host" => "yourip:8082",
"Connection" => "Keep-Alive",
"Cookie" => "X-IdentityToken"
);
my $res = $ua->request($req);
if ($res->is_success) {
# print $res->content;
$code = $res->code;
$code = $type." ".$code;
} else {
print $res->error_as_HTML;
printf "%s\n", $res->status_line;
}
my $content = $res->content();
$dstring = "";
if ($pxml == 1) {
lookXML($content)
} else {
$dstring = "do work here";
};
$content = $res->as_string;
print $content;
print "\n";

#---------------------------------------------------------------
# Uncomment the below 4 lines to save the returned web pages
# to files. NOTE: This won't work unless you manually
# create the 'out' directory.
#---------------------------------------------------------------
my $file = "./out/".$tag.".out";
open(FL,">$file") || die "Could not open $file: $!\n";
print FL $content."\n\n";
print FL "DEBUG content:\n\n";
print FL $dstring."\n\n";
close(FL);

return $code;
}


#-----------------------------------------------------------
# lookXML() - parses XML to view data
# tag names are hard coded. depending on the request, the
# start, end, and cdata methods below will need to be edited
# to support additional XML tag names.
#-----------------------------------------------------------
sub lookXML {

my($content) = @_;

# initialize xml parser
my $xp = new XML::Parser();
# set callback functions
$xp->setHandlers(Start => \&start, End => \&end, Char => \&cdata);
# parse XML
$xp->parse($content);
# keep track of which tag is currently being processed
my $currentTag = "";

# this is called when a xml start tag is found
sub start()
{
# extract variables
my ($parser, $name, %attr) = @_;
# $currentTag = lc($name);
$currentTag = $name;

if ($currentTag eq "moreovernews")
{
$dstring = $dstring."<table>";
}
if ($currentTag eq "article")
{
$dstring = $dstring."<tr>";
}
elsif ($currentTag eq "url")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "headline_text")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "source")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "media_type")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "cluster")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "tagline")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "document_url")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "harvest_time")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "access_registration")
{
$dstring = $dstring."<td>";
}
elsif ($currentTag eq "access_status")
{
$dstring = $dstring."<td>";
}

}
# this is called when an end tag is found
sub end()
{
my ($parser, $name) = @_;
#$currentTag = lc($name);
$currentTag = $name;

if ($currentTag eq "moreovernews")
{
$dstring = $dstring."</table>\n";
}
if ($currentTag eq "article")
{
$dstring = $dstring."</tr>\n";
}
elsif ($currentTag eq "url")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "headline_text")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "source")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "media_type")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "cluster")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "tagline")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "document_url")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "harvest_time")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "access_registration")
{
$dstring = $dstring."</td>\n";
}
elsif ($currentTag eq "access_status")
{
$dstring = $dstring."</td>\n";
}
# clear value of current tag
$currentTag = "";

}

# this is called when CDATA is found
sub cdata()
{
my ($parser, $data) = @_;

if ($currentTag eq "moreovernews")
{
$dstring = $dstring."$data";
}
if ($currentTag eq "article")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "url")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "headline_text")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "source")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "media_type")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "cluster")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "tagline")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "document_url")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "harvest_time")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "access_registration")
{
$dstring = $dstring."$data";
}
elsif ($currentTag eq "access_status")
{
$dstring = $dstring."$data";
}
}
}


(This post was edited by mozkill on May 9, 2002, 3:15 PM)


Jasmine
Administrator

Jun 19, 2002, 4:39 AM

Post #2 of 2 (1432 views)
Re: [mozkill] Web Service Test Script (moreover.com) [In reply to] Can't Post

Is there a question in here?

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives