#!perl
#---------------------------------------------------------------------
+--------
#
#  Relocator
#
#  Written:  2001/12/12  Dingus
#  Modified: 2002/07/26  Dingus
#
#  Redirects you to another port on the same server. Either as a redir
+ect or
#  as an embedded frame. You can call it in 2 ways: either call direct
+ 
#    relo.cgi?p=PPP&m=C&t=TTT
#    where PPP is the port for the redirect
#    C is either an R for redirect or an F for frame
#    TTT is a title used to give the frame mode a title. It is ignored
+ in R mode
#  or use as the script for a service.xml script
#    e.g. a SWAT service redirector would look like
#    <RELO>
#      <SERVICE NAME='Swat' PORT='901' MODE='FRAME'/>
#    </RELO>
#
#  Modification allows you to do redrects to remote servers too using 
#  either relo.cgi?u=URI&m=C&t=TTT or 
#    <RELO>
#      <SERVICE NAME='Remote Server' MODE='FRAME'
#        URI='http://remote.example.com/path/to/somewhere.html' />
#    </RELO>
#  Note that the direct call method will not cope well with URIs that 
+have 
#  their own query strings (i.e. URIs of the form http://some/where?qu
+ery )
#
#---------------------------------------------------------------------
+--------

use CGI::Carp qw(fatalsToBrowser set_message);
use CGI qw(:standard);
use XML::Simple;

# --------------------------------------------------------------------
+---------
# standard error handlng stuff.
# --------------------------------------------------------------------
+---------

BEGIN {
  sub handle_errors {
    my $msg = shift;
    print "<h1>Script Error</h1> running".$ENV{'SCRIPT_NAME'}."<p><pre
+>";
    $msg =~ s/ (of )*\Q$0//g;
    print "$msg</pre><A HREF='mailto:myemail@ddress'>Email me this pag
+e</a>";
    return unless ($ENV{'REMOTE_ADDR'} eq "127.0.0.1");
    print '<p><B>Environment Variables:</B><PRE>';
    foreach (sort keys %ENV) {
    print "$_: [$ENV{$_}]\n";
    }
    print "</pre></BODY></HTML>";
    }
  set_message(\&handle_errors);
}

# --------------------------------------------------------------------
+---------
# Do the redirect / frame
# --------------------------------------------------------------------
+---------

my %relo = ('MODE'=>'REDIRECT', PORT=>'8080');
if (path_info()) {
    $fn = $ENV{'DOCUMENT_ROOT'}.path_info().'.xml';
    die "Can't use ".path_info() unless -e($fn);
    $xml = XMLin($fn);
    %relo = (%relo, %{$$xml{'SERVICE'}});
}
else {
    my %conv = ( 'u'=>'URI', 'm'=>'MODE', 'p'=>'PORT', 'n'=>'NAME' );
    for (url_param()) {
    $relo{$conv{$_}} = url_param($_) if (exists $conv{$_});
    }
}
$uri = ($relo{'URI'} or 'http://'.$ENV{'HTTP_HOST'}.":$relo{'PORT'}/")
+;
if (uc(substr($relo{'MODE'},0,1)) eq 'F') {
    $relo{'NAME'} = "Relo to $uri" unless ($relo{'NAME'});
    print <<EOFRAME ;
<HTML><HEAD>
<TITLE>$relo{'NAME'}</TITLE></HEAD>
<FRAMESET cols='*'>
  <FRAME name="In" src='$uri'>
  <NOFRAMES>
  <H1>Sorry!</H1>
  <H3>This page must be viewed by a browser that is capable of viewing
+ frames.</H3>
  </NOFRAMES>
</FRAMESET></HTML>
EOFRAME
}
else {
    print redirect($uri);
}

[download]

In reply to The Ultimate Rediector CGI Script by dingus

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.