#!/usr/bin/perl
# Script som legger inn en knapp for å bryte ut av frames.
#
# Det tar en url som argument (eks. add_frames_remover?http://test/test.html)
# leser dokumentet, og legger inn link til samme dokument med target satt
# til "_top".
# Altså vil et trykk på linken føre til at dokumentet fyller hele browser
# vinduet.
$LYNX_PATH = '/usr/bin/lynx'; # Hvor er lynx?
$BREAK_FREE_HTML = "[View this document full screen with graphics]"; # Hva man trykker på
$BREAK_FREE_TXT = "[View this document full screen]"; # Hva man trykker på
# Returner alt utenom filnavnet fra en URL.
# (http:/x.x.x/dir/fil.html -> http://x.x.x/dir/
sub getDirectory
{
my ($dir) = ($_[0] =~ /(.*\/)?[^\/]*$/ ); #Strip directory
return $dir;
}
# Returner navnet på filen i en URL. Omvendt av getDirectory
# (http:/x.x.x/dir/fil.html -> fil.html
sub getFileName
{
my ($file) = ($_[0] =~ /\/([^\/]*)$/);
return $file;
}
# Returner navnet på serveren. (Alt mellom http:// og / eller $)
sub getHost
{
my ($site) = ($_[0] =~ /^http:\/\/([^\/]+)?(\/|$)/ );
return $site;
}
# Fjerner unødige ../katalog strukturer
sub fixDoubleDotProblem
{
my $url = $_[0];
#$url =~ s/\/[^\/]*?\/\.\.//g; #fjerner /directory/.. "mønster"
return $url;
}
# Legger til en / på URL'en hvis den antas å peke på en katalog
sub fixMissingSlashProblem
{
my $url = $_[0];
my $name = getFileName( $url );
if( $name ne "" ) #URL ender ikke med en / ? - hmmm...
{
if( not getFileName( $url ) =~ /\./ ) #Inneholder navnet '.' ?
{
$url .= "\/"; #Nei, antar det er en katalog, legg til /
}
}
return $url;
}
# Konverterer relative URL'er til absolutte ut i fra URL'en til
# .hmml filen.
sub makeQualifiedUrl
{
my( $toPath, $fromPage ) = @_;
#Er $toPath en fullt kvalifisert URL (absolutt)?
if( ! ($toPath =~ /^http:\/\//i) ) #Starter den med http:// ?
{
if( $toPath =~ /^\// ) #Starter den med / ?
{
#Start fra http://www.host.com
$toPath = "http://" . getHost($fromPage) . $toPath;
}
else # Den starter med en katalognavn
{
#Start i $page-dir
$toPath = getDirectory($fromPage) . $toPath;
}
$toPath = fixDoubleDotProblem( $toPath ); #Fjern ..'er
$toPath = fixMissingSlashProblem( $toPath ); #Legg til / hvis det trengs
}
return $toPath;
}
#$url = "http://almashriq.hiof.no/lebanon/300.social_sciences/360.sp";
#print makeQualifiedUrl("363.other_s_pas/" , $url);
#exit;
# mime header
print "Content-type: text/html\n\n";
# Argument fra url: /cgi-bin/add_frames_remover?URL
$url = $ENV{'QUERY_STRING'};
# Sett sammen link
$link_html = "$BREAK_FREE_HTML";
$link_txt = "$BREAK_FREE_TXT";
# Les dokumentet
$document = `$LYNX_PATH -source $url`;
#
# Fjern bilder og flett inn linker i htmlkoden.
#
# Antar at dokumentet er html hvis det inneholder en tag.
if( $document =~ /]*?>)/$1$link_html/i;
$document =~ s/(<\/body[^>]*?>)/$1$link_html/i;
# Fjern bakgrunnsbilde
$document =~ s/(]*)?background\s?=\s?[^ >]+/$1/i;
# Fjern alle bilder
$document =~ s/]+?>/[IMG]/gi; #Fjern
# Legg til ny target på linkene
$document =~ s/href/target=\"_top\" href/gi;
# Konverter alle linkene til absolutte.
$document =~ s/(\s+href\s*=\s*\"?\'?)(.+?)([\"\'\s>])/"$1".makeQualifiedUrl($2 , $url)."$3"/ige;
}
# ... hvis ikke - legg til nok html til å vise linken.
else {
$document = "".
"".
$link_txt.
"$document
".
$link_txt.
"".
"";
}
# Skriver ut hele dokumentet
print $document;