RE: Perl script works on Windows 2000, but not on Windows 2003 .. why?

[ggordon]

The following script, when placed on a Windows 2000 server runs fine. This is a script that will print out information from any webpage .. in a printer friendly format. But, when I try to use this script (with the same html page and coding) on a Windows 2003 server, the text that should be appearing between the "header" and "footer" simply doesn't get pulled in. This area (when running on a Windows 2003 server) is left blank.

I am not sure if there's something wrong in the script .. or if something on the Windows 2003 server needs to be modified (with regard to IIS). But all my other Perl scrips that run on the Windows 2003 server are running fine. I am only having a problem with THIS script. So, I am hoping that someone who knows Perl better than I might be able to figure out what's wrong.

Here's the script:
===================================


#!/usr/bin/perl
################

$| = 1;
$addheadsection=1;
$addopeningbodytag=1;
$addcloseingbodytag=1;
$addprintpagefooter=0;
#$db=1;
ps();
$rdata=($ENV{'PATH_TRANSLATED'})?'PATH_TRANSLATED':'SCRIPT_FILENAME';
read(STDIN, $xbuffer, $ENV{'CONTENT_LENGTH'});mih($xbuffer,'INPUT');
$details=$ENV{'QUERY_STRING'};mih($details,'PROCESS');
sub mih{my($take,$tag)=@_;local($pair,$name,$contents,@pairs);@pairs=split(/&/,$take);
foreach $pair (@pairs) {($name, $contents) = split(/=/, $pair);$contents =~ tr/+/ /;
$contents =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $contents=~s!\|!|!gs;
$$tag{$name}=($$tag{$name}) ? $$tag{$name}.','.$contents : $contents; } }
$isMac=($ENV{HTTP_USER_AGENT}=~/mac/i)?1:0; $isIE=($ENV{HTTP_USER_AGENT}=~/msie/i)?1:0;
$ds=($ENV{'SERVER_SOFTWARE'}=~/microsoft/i)?"\\":"\/";
############################################################################################
@INIT=(SERVER_ADDR,HTTP_HOST,SCRIPT_NAME,SERVER_NAME,DOCUMENT_ROOT,$rdata);
foreach $init(@INIT){$$init=$ENV{$init};} $SCRIPT_NAME=~m!([A-Za-z0-9]+\.[plcgiPLCGI]+$)!;
$this_prog=$1;$$rdata=~m!(.*?)$this_prog!; $my_base_loc=$1;
$my_base_loc=~s!\/+!\/!g;db(my_base_loc,$my_base_loc);
$siteloc=('

http://'.$HTTP_HOST.$subloc);

$lsiteloc=($lsiteloc)?$lsiteloc:$siteloc;
$cgiloc=('

http://'.$HTTP_HOST.$cgisub);

$my_http=('

http://'.$HTTP_HOST.$SCRIPT_NAME);

$dloc=($my_base_loc.'data'.$ds);
$cfgfile=($my_base_loc.'hidata.cfg');
@vl=use_this_file('',$cfgfile);
foreach $lx(@vl){chomp $lx;if($lx && $lx !=~/^#/){$lx=~m!([A-z0-9\-\_]+)\|(.+)!;$mn=$1;$mm=$2;$$mn=$mm;db($mn,$$mn);}}
$kx='rabbit';$#vl=-1;
##$reqfile=($my_base_loc.'HTTP_LIB.PL');
#require "$reqfile";

#############################################################################################
@processes=('logon','log2','pbox2','anum','emode','wmode','delno','smode');
$test_it=0;
$gnum=0;
while ($test_it < 1) {
$val = $processes[$gnum];
if ($PROCESS{$val}) {$test_it=1;}
if ($gnum > $#processes) {$test_it=1;}
$gnum++;} # end while ($test_it < 1)
if ($PROCESS{$val}) {&$val;}
else {
&primary;
#&pcv;
$| = 0; }
#############################################################################################
sub primary {
my ($gr,@jk);
my $grab=$ENV{'HTTP_REFERER'};
$grab=~m!([A-z]+)\:\/\/([A-z0-9\-\.]+)\/([\S]+)!; $tld=$2;$ipx=$3; $ipx="\/$ipx";
@jk=gfi($ipx,$tld,80);foreach $l(@jk){$gr.=$l;}$gr=pclean($gr);
$beg=($gr=~/\<[ ]*head[ ]*\>(.*?)\<[ ]*\/[ ]*head[ ]*\>/is)?$1:'';
$gr=~s!\<\/head\>!!i;
$end=$gr;
$seg=''; undef @segs; undef %segs; undef %done_ha;
$xn=1;
while($gr=~/\<div id=\"gmgprint([0-9]*)\"\>(.*?)\<\/div\>/is){
$gr=~s/\<div id=\"gmgprint([0-9]*)\"\>(.*?)\<\/div\>//is;
($num,$cont)=($1,$2); if(!($num=~/[0-9]/)){$num=$xn;} while($done_ha{$num}){$num++;} $num=ldzeros($num,8);
$segs{$num}=$cont; push @segs,$num;$xn++;}
@segs=sort @segs; #foreach $s(@segs){print "$s<br>";}
while(@segs){$seg.=$segs{shift @segs}.'<br>';}
$h=$f='';
$hfile=$my_base_loc.'header.html';
if(-s $hfile){@tt=use_this_file('',$hfile);$h=pclean(file_text('tt')); }
$ffile=$my_base_loc.'footer.html';
if(-s $ffile){@tt=use_this_file('',$ffile);$f=pclean(file_text('tt')); }
$addheadsection=($h=~/\<[ ]*\/[ ]*head[ ]*\>/i)?0:$addheadsection;
$addopeningbodytag=($h=~/\<[ ]*body\b[^\>\<]*\>/i)?0:$addopeningbodytag;
$addcloseingbodytag=($f=~/\<[ ]*\/[ ]*body[ ]*\>/i)?0:$addcloseingbodytag;

$js=qq~\n<script language="javascript">
var IE=(navigator.appName == "Microsoft Internet Explorer")? true: false;
var NS=(navigator.appName == "Netscape")? true: false;
var nVer= parseInt(navigator.appVersion);
var nPlat = navigator.platform;
var isMac=(nPlat.match(/mac/i))?1:0;
function printMe() { \nif(IE && isMac) {
alert("Sorry, your browser does not support this function. \\nPlease select Print from your file menu.")
} else { \nwindow.print(); \n } \n return true;\n}
</script>\n~;
$hr=qq~<div align="left"><hr style="width:620px;height:1px;color:#B73B4D" noshade></div>~;
$footer=qq~$hr
<div style="line-height:15px;font-family:Arial,Helvetica,sans-serif;font-size:11px;color:#B73B4D">
<span style="font-size:13px;font-weight:bold"><a href="\#" onClick="printMe();">&#167; Print this page</a></span>
</div>$hr~;
$footer=($addprintpagefooter)?$js.$footer:'';
$closetag=($addcloseingbodytag)?'</body>':'';
$opentag=($addopeningbodytag)?'<body bgcolor="#FFFFFF">':'';
$head=($addheadsection)?"<head>$beg</head>":'';
print qq~$head\n$h\n$opentag\n$seg\n$f\n$footer\n$closetag\n~;

}
#############################################################################################
sub ldzeros {my($in,$n,$m)=@_;if($m){while($in=~/^0/){$in=~s!^0!!g;}}
else{while(length($in)<$n){$in="0$in";}} return $in;}
#############################################################################################
sub gfi{ my ($ipx,$server,$port)=@_;
local ($ret,$gr,$alias,$name,$atype,$dlen,$sin,$len,$offset,$written,$buff,@addrs,@result);
$xtimeout||=3; use Socket;
socket(SOCK1, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]) || return ((""));
($name,$alias,$atype,$dlen,@addrs)=gethostbyname($tld);
$alias=($alias)?"\nHost: $alias":'';
$ret=qq~GET $ipx HTTP/1.0$alias\nAccept: text/plain\nAccept: text/html\n\n~;
$sin=sockaddr_in($port,$addrs[0]);
connect(SOCK1, $sin);
$offset=0;$buff=$ret."\r\n";$len=length($buff);while($len){
$written=syswrite(SOCK1,$buff,$len,$offset);$len -=$written;$offset +=$written;}
@result=<SOCK1>;
close(SOCK1);return(@result);}
#############################################################################################
sub use_this_file ($$;$$){my($method,$file,$do_this,$print_this) = @_;
$#this_list=-1;open (INFILE, "$method$file"); @fstats=stat(INFILE);
if ($do_this) {&$do_this;}$do_this="";
if ($print_this) {print INFILE $print_this;$print_this="";}
else {@this_list= <INFILE>; }close (INFILE); return(@this_list); }
#############################################################################################
sub file_text ($){my($aname) = @_;my($ftext,$lx);foreach $lx(@$aname){chomp $lx;$ftext.="$lx\n";}
return ($ftext);}
##############################################################################################
sub get_page { local($opener)=@_; open (INFILE,"$opener"); @page = <INFILE>;close (INFILE);
$opener=""; local $body=""; foreach $value(@page) {$body .=$value;}
$body=~s!my_http!$my_http!igs; $body=pclean($body); $body=~s!html_loc!$siteloc!gis; $body=~s!cgi_loc!!gis;
return($body); }
#############################################################################################
sub pclean {my($out)=@_;
$out=~s!([\"\'])(\.\.\/)+!$1\/!gi; $out=~s!src([ ]*\=[ ]*[\"\']http)!sgc\1!gis;
$out=~s!href([ ]*\=[ ]*[\"\']http)!gref\1!gis;$out=~s!href([ ]*\=[ ]*[\"\']java)!gref\1!gis;
$out=~s!href([ ]*\=[ ]*[\"\']\#)!gref\1!gis; $out=~s!background([ ]*\=[ ]*[\"\']http)!gackground\1!gis;
$out=~s!src([ ]*\=[ ]*[\"\'])!src\1$siteloc\/!gis; $out=~s!href([ ]*\=[ ]*[\"\'])!href\1$siteloc\/!gis;
$out=~s!background([ ]*\=[ ]*[\"\'])!background\1$siteloc\/!gis;$out=~s!href=\"$siteloc\/http!href=\"http!gis;
$out=~s!$siteloc\/\#!\#!gis;$out=~s!$siteloc\/javascript!javascript!gis;
$out=~s!href=\"$siteloc\/mailto!href=\"mailto!gis;$out=~s!sgc[ ]*\=!src\=!gis;
$out=~s!gref[ ]*\=!href\=!gis;$out=~s!gackground[ ]*\=!background\=!gis;$out=~s!$siteloc$siteloc!$siteloc!gis;
$out=~s!([A-z0-9\:]+)/+([A-z0-9]+)!$1/$2!gi;$out=~s!http:/!

http://!gis;return

($out); }
##########################################################################################################
sub db {
local($desc,$descval)=@_;
if($db) {ps(); print qq~<font color="#ff0000">$desc</font> $descval<br>~; }
}
############################################################################################
sub ps {
if(!$ps) { print "Content-type: text/html\n\n"; $ps=1; }
}
#############################################################################################

=====

I hope some genius can figure out what the problem might be. I am going crazy.

Thanks,
Gary


Gary M. Gordon
ggordon@garymgordon.com

 

[PaulTEG]

Is there any info in the error logs?

Try this line

use CGI::Carp (fatalsToBrowser);

It may give more information to the browser, but if it 's printing the header and footer, then it might not

Repost the code in

 tags, it's a bit unweildy to read at present.

Have you tried putting some debug print statements in there

--Paul

 

[ggordon]

Thanks.

I'll try that.

Gary

Gary M. Gordon
ggordon@garymgordon.com