Hi,
I'm writing a script which needs to be hosted on a remote server that only has version 5.005_03 of Perl installed on it. The host are refusing to update their version of perl and so I am left with trying to make my script work on their servers, but requires in order to work.
As you will see from the script below, I have created a lib folder and have put the necessary files into the lib folder however I am still recieving an error saying "'d:\h\o\hostpipe\ script produced no output"
I would be grateful for any suggestions that could point me in the right direction.
Rob Waite
I'm writing a script which needs to be hosted on a remote server that only has version 5.005_03 of Perl installed on it. The host are refusing to update their version of perl and so I am left with trying to make my script work on their servers, but requires in order to work.
As you will see from the script below, I have created a lib folder and have put the necessary files into the lib folder however I am still recieving an error saying "'d:\h\o\hostpipe\ script produced no output"
I would be grateful for any suggestions that could point me in the right direction.
Code:
#!/usr/bin/perl
# Rob Waite 04/2005, 06/2005
# Gets user input in form of SKU number, searches uk.shopping.com and then gives out results.
use lib "d:/h/o/hostpipe/[URL unfurl="true"]www/ecaps/temp/lib";[/URL]
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use LWP::Simple qw($ua get getstore);
use LWP::UserAgent;
use Sprite;
use Time::Local;
use Strict;
#use Warnings;
use [URL unfurl="true"]WWW::Mechanize;[/URL]
print qq "Content-Type: text/html\n\n";
my $in = $ENV{'QUERY_STRING'};
@in = split(/[&;]/,$in);
my ($etc,$input) = split/=/,$in[0];
my ($etc,$TextMsg) = split/=/,$in[1];
$TextMsg = URLDecode($TextMsg);
if ($input eq "") {
print qq ~
<html>
<head>
<title>Text4Price - uk.shopping.com submission form</title>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">
<\/head>
<body>
<form name="SKU Sub Form" method="GET" action="ukshopping.pl">
Please enter an SKU (i.e. M9725LLA):
<input type="hidden" name="input" value="1">
<input type="text" name="TextMsg">
<input type="submit" name="Submit" value="Submit">
</form>
<\/body>
<\/html>
~;
} elsif ($input == 1) {
if ($TextMsg eq "") {
print "1::Text message sent appears to be blank, please try again. <A href=\"ukshopping.pl\">Back</a>";
} else {
&option_1;
}
}
sub option_1 {
#### Uses Mechanize to produce search results based on the text message input ####
$mech = [URL unfurl="true"]WWW::Mechanize->new();[/URL]
$mech->agent_alias( 'Windows IE 6' );
my $url = '[URL unfurl="true"]http://uk.shopping.com/';[/URL]
$mech->get($url);
$_ = $mech->content();
$mech->set_visible( $TextMsg ) ;
$mech->submit_form(
form_number => 1,
);
my $text = $mech->content();
$SKU = $1 if $text =~ /add\-value=\"([^\"]*)\"/i;
if ($text =~ /Compare all /i) {
($etc,$text) = split/<div class="moreStores">/i,$text;
($etc,$text) = split/<a href="\//i,$text;
($HREF,$etc) = split/">/,$text;
$HREF =~ s/^\s+|\s+$//;
$mech->follow_link( text_regex => qr/Compare all /i );
$text = $mech->content();
&parseSKU($text,0,$HREF);
} elsif ($text =~ /We couldn't find any product matches on /i) {
print "2::No entries found for (".$TextMsg.")";
} elsif ($text =~ /Low to High/i) {
$mech->follow_link( text_regex => qr/Low to high/i );
$text = $mech->content();
&parseSKU($text);
} elsif ($text =~ /in the following categories/i) {
$mech->follow_link( text_regex => qr/See all matches/i );
$text = $mech->content();
&parseCAT($text,1);
} elsif ($text =~ /find by brand/i || $text =~ /Not Looking For /i || ($text =~ /You found /i && $text !~ /Did you mean/i)) {
$mech->follow_link( url_regex => qr/xpc/i );
$text = $mech->content();
&parseSKU($text,1);
} elsif ($text =~ /Did you mean /i) {
print "6::Found manufacturer but not product for (".$TextMsg.")";
} else {
print "3::Unknown source code developed in intial search for (".$TextMsg.")";
}
}
sub parseSKU {
%hash = ();
$text = @_[0];
$multiple = @_[1];
$HREF = @_[2];
$id = 1;
if ($HREF eq "") {
($etc,$HREF) = split/<a id="productImage" href="\//i,$text;
($HREF,$IMG) = split/">/i,$HREF,2;
$HREF =~ s/^\s+|\s+$//gi;
$HREF =~ s/xPF-/xPC-/gi;
($etc,$IMG,$ect) = split/"/,$IMG,3;
}
if ($IMG eq "") {
($etc,$IMG) = split/<a id="productImage" href="\//i,$text;
($etc,$IMG) = split/<img src=/i,$IMG;
($etc,$IMG,$ect) = split/"/,$IMG,3;
}
$Title = $1 if $text =~ /<div class="pagetitle">([^<]*)</i;
$Title =~ s/\ \;//g;
$Title =~ s/Compare prices on the //gi;
my $PriceRange = $1 if $text =~ /<span id="priceRangeSpan">([^<]*)</i;
PARSESKU:
(my $etc,$text) = split/<tr class="first">/i,$text;
($text,$etc) = split/<\/table>/i,$text;
my @list = split/<tr>/,$text;
foreach my $line(@list) {
my ($bl1,$Reviews,$Avail,$Price,$BestPrice,$Seller) = split/<\/td>/i,$line;
$Reviews = $1 if $Reviews =~ /<br\/><u>([^<]*)</i;
$Avail = $1 if $Avail =~ /<div class="instock">([^<]*)</i;
$Avail = $1 if $Avail =~ /<div class="outstock">([^<]*)</i;
$Avail = $1 if $Avail =~ /<div class="unstock">([^<]*)</i;
$Price =~ s/,//g;
$Price = $1 if $Price =~ /£([^<]*)</i;
$Price = sprintf("%.2f", $Price);
$BestPrice =~ s/,//g;
$BestPrice = $1 if $BestPrice =~ /£([^<]*)</i;
$BestPrice = sprintf("%.2f", $BestPrice);
my $Postage = eval($BestPrice - $Price);
$Postage = sprintf("%.2f", $Postage);
$hash{ $id }{ 'Price' } = $Price;
$hash{ $id }{ 'BestPrice' } = $BestPrice;
$hash{ $id }{ 'id' } = $id;
$hash{ $id }{ 'Avail' } = $Avail;
$hash{ $id }{ 'PriceRange' } = $PriceRange;
$hash{ $id }{ 'Title' } = $Title;
$hash{ $id }{ 'HREF' } = $HREF;
$hash{ $id }{ 'Postage' } = $Postage;
$hash{ $id }{ 'IMG' } = $IMG;
$id++;
}
if ($mech->follow_link( text_regex => qr/See Next /i )) {
$text = $mech->content();
goto PARSESKU;
}
if ($multiple == 1) {
$NoResults = "Multiple Results";
}
# while (($id, $id{ 'BestPrice' }) = each(%hash)){
# print $hash{ $id }{ 'id' }.", ".$hash{ $id }{ 'BestPrice' }."<br />";
# }
@sorted = sort { $hash{ $a }->{ 'BestPrice' } <=> $hash{ $b }->{ 'BestPrice' } } keys %hash;
$sortedID = $sorted[0];
# print $sortedID."<br />";
print qq ~
0::$hash{ $sortedID }{ 'Title' }::$hash{ $sortedID }{ 'SKU' }::$hash{ $sortedID }{ 'BestPrice' }::$hash{ $sortedID }{ 'Avail' }::$hash{ $sortedID }{ 'HREF' }::$hash{ $sortedID }{ 'IMG' }
~;
}
sub parseCAT {
$text = @_[0];
($etc,$text) = split/All Matching Categories/gi,$text;
($etc,my $Flink) = split/<a href="\/[^>]*>/gi,$text;
($Flink,$text) = split/</gi,$Flink;
$mech->follow_link( text_regex => qr/$Flink/i );
$text = $mech->content();
if ($text !~ /Compare prices on the /i && $text =~ /you found /i ) {
$mech->follow_link( url_regex => qr/XPc-/i );
$text = $mech->content();
} else {
print "4::No Match in parseCat - Matching Categories";
}
if ($text =~ /Low to High/i) {
$mech->follow_link( text_regex => qr/Low to high/i );
$text = $mech->content();
&parseSKU($text);
} else {
print "5::No Match in parseCat - SKU not developed";
}
}
sub URLDecode {
my $theURL = $_[0];
$theURL =~ tr/+/ /;
$theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
$theURL =~ s/<!--(.|\n)*-->//g;
return $theURL;
}
sub URLEncode {
my $theURL = $_[0];
$theURL =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
return $theURL;
}Rob Waite