Hi,
What I am looking for is a script that I can call from a webpage,
strips the not needed information from that webpage (outside the
<print></print> tags) and returns the lot with custom colors (black on
white) to a new window, so the page can be printed easily.
I am using the code you'll find below and it works.
There is one problem though: I want all url's to become absolute urls,
so that also (relative) images will become visible.
I know I should work with URI::URL and I have it on my server, but I
do not how to use with this script. Actually, my knowledge of perl is
very poor, I wouldn'ty know how to use it in any script...
Can somebody help?
Thanks,
Lex
code:
#!/usr/bin/perl
####################################################################
#define this homepath as the root directory of your web site
$homepath="/dnshome/peng.nl/htdocs/";
#GATHER THE INFORMATION
#Are you on nt, mac, or unix?
$platform="unix";
#What's the web path to the ease-zine directory?
$footer="footer.html";
$index="index.html";
$domain=$ENV{'SERVER_NAME'};
$homepath=~ s/\\/\//g;
$source=$ENV{'HTTP_REFERER'};
#DISCOVER THE SOURCE FILE
$source_file=$source;
$source_file=~ s/http\:\/\///g;
$source_file=~ s/$domain//g;
if (substr($source_file,-1,1) eq "/"){
$source_file=$source_file."$index";
}
if (substr($source_file,0,1) eq "/"){
chop($homepath);
}
$source_file=$homepath.$source_file;
if($platform eq "nt"){
$source_file=~ s/\//\\/g;
}
elsif($platform eq "mac"){
$source_file=~ s/\//\:/g;
}
#MAKE SURE IT EXISTS
if (-e $source_file){
$test="yes";
Quote:
}
open (SOURCE,"$source_file");
foreach $line (&read_file("SOURCE"))
{
$line =~ s/[cC][oO][lL][oO][rR]=/oldclr=/g;
$line =~ s/[bB][aA][cC][kK][gG][rR][oO][uU][nN][dD]=/oldbck=/g;
$line =~ s/[tT][eE][xX][tT]=/oldtxt=/g;
$line =~ s/[lL][iI][nN][kK]=/oldlnk=/g;
$line =~ s/$ENV{'SCRIPT_NAME'}/$source/g;
$line =~s/button_in\.gif/button_out\.gif/g;
$output=$output.$line."\n";
}
close(SOURCE);
#2001 Code for tag support
$max=200;
$counter=0;
$strip = $output;
$strip =~ s/\n/ /g;
$strip=~ s#</[pP][rR][iI][nN][tT]>#<XX>#;
$strip =~ s#<[pP][rR][iI][nN][tT]>#<XX>#;
until ($counter> $max){
$counter++;
$theoutput=$theoutput.$lines[$counter];
}
$output=$theoutput;
print "content-type:text/html\n\n";
print qq|
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title></title>
<LINK rel = STYLESHEET
href =
" http://www.*-*-*.com/ ;
Type = "text/css" >
</head>
<body>
<div align="center"><font size="-2">Voor de laatste versie van deze
pagina kunt u op $domain terecht, wel te
weten:<br><strong>$source</strong></font></div>
<hr width="100%" size="1" noshade>
<p>
|;
print $output;
open(FOOTER, "$footer") || print "no file found $footer!";
$template = "";
while(<FOOTER>)
{
$template .= $_;
}
close(FOOTER);
print "$template\n";
exit;
# THESE ARE COMMON SUBROUTINES
####################################################################
# PARSE SUBROUTINE
sub parse_form {
read(STDIN, $cache, $ENV{'CONTENT_LENGTH'});
if (length($cache) < 5) {
$buffer = $ENV{QUERY_STRING};
}
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
Quote:
}
# READ LISTING
# OPEN LISTING
sub open_file {
open ($filevar,$filemode . $listings) ||
die ("Can't open $listings");
Quote:
}
# READ LISTINGS
sub read_file
{
while(<$file_var>)
{
chop;
}
close($file_var);
Quote:
}
# STRIP SUBROUTINE
sub strip {
$cheese =~ s/\n/<P>/g; # should use this.
$cheese =~ s/%95/<li>/g;
$cheese =~ s/\r/<P>/g;
return ($cheese);
Quote:
}
#all required scripts must return successfully;
1;
how to use URI::URL ?