how to use URI::URL ? 
Author Message
 how to use URI::URL ?

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;


Sun, 16 May 2004 13:36:14 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Error while using URI::URL

2. Looking for advice on using URL::URI module

3. Can't locate URI::URL.pm in @INC using XML::Parser.pm

4. Newbie URI::URL question

5. Newbie URI::URL question

6. URI::URL module

7. URI::URL and FILE::BASENAME???????????????

8. URI:: URL Question

9. URI::URL 3.00 released

10. weird behavior with URI::URL

11. URI::URL

12. encoding problems with URI::URL

 

 
Powered by phpBB® Forum Software