XAO::DO::Web::Redirect - browser redirection object


XAO-Web documentation Contained in the XAO-Web distribution.

Index


Code Index:

NAME

Top

XAO::DO::Web::Redirect - browser redirection object

SYNOPSIS

Top

 <%Redirect url="/login.html"%>

DESCRIPTION

Top

Redirector object. Can set cookies on the redirect.

Arguments are:

 url        => new url or short path.
 target     => target frame (optional, only works with Netscape)
 base       => if set uses base site name (optional)
 secure     => if set uses secure protocol (optional)
 permanent  => use status 301 (default is 302)

EXPORTS

Top

Nothing.

AUTHOR

Top

Copyright (c) 2005 Andrew Maltsev

Copyright (c) 2001-2004 Andrew Maltsev, XAO Inc.

<am@ejelta.com> -- http://ejelta.com/xao/

SEE ALSO

Top

Recommended reading: XAO::Web, XAO::DO::Web::Page.


XAO-Web documentation Contained in the XAO-Web distribution.
###############################################################################
package XAO::DO::Web::Redirect;
use strict;
use XAO::Utils;
use base XAO::Objects->load(objname => 'Web::Page');

use vars qw($VERSION);
$VERSION=(0+sprintf('%u.%03u',(q$Id: Redirect.pm,v 2.1 2005/01/14 01:39:57 am Exp $ =~ /\s(\d+)\.(\d+)\s/))) || die "Bad VERSION";

###############################################################################

sub display {
    my $self=shift;
    my $args=get_args(\@_);
    my $config=$self->siteconfig;

    ##
    # Checking parameters.
    #
    if(! $args->{url}) {
        eprint "No URL or path in Redirect";
        return;
    }

    ##
    # Additional fields into standard header.
    #
    my %qa=(
        -Status => $args->{permanent} ? '301 Permanently Moved' : '302 Moved'
    );

    ##
    # Target window works only with Netscape, but we do not care here and
    # do our best.
    #
    if($args->{target}) {
        dprint ref($self),"::display - 'target=$args->{target}' does not work with MSIE!";
        $qa{-Target}=$args->{target};
    }

    ##
    # Getting redirection URL
    #
    my $url;
    if($args->{url} =~ /^\w+:\/\//) {
        $url=$args->{url};
    }
    else {
        my $base=$args->{base};
        my $secure=$args->{secure};
        my $url_path=$args->{url};
        if(substr($url_path,0,1) eq '/') {
            my $base_url=$self->base_url(
                active  => $base ? 0 : 1,
                secure  => $secure,
            );
            $url=$base_url . $url_path;
        }
        else {
            $url=$self->pageurl(
                active  => $base ? 0 : 1,
                secure  => $secure,
            );
            $url=~s/^(.*\/)(.*?)$/$1$url_path/;
        }
    }

    ##
    # Redirecting
    #
    $qa{-Location}=$url;
    $config->header_args(\%qa);
    $self->finaltextout(<<EOT);
The document is moved <A HREF="$url">here</A>.
EOT
}

###############################################################################
1;
__END__