File Coverage

blib/lib/XAO/DO/Web/Redirect.pm

Criterion	Covered	Total	%
statement	21	33	63.6
branch	4	14	28.5
condition			n/a
subroutine	4	4	100.0
pod	1	1	100.0
total	30	52	57.6

=head1 NAME

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

=head1 SYNOPSIS

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

=head1 DESCRIPTION

Redirector object.
Can set cookies on the redirect.

=cut

###############################################################################
package XAO::DO::Web::Redirect;
use strict;
use XAO::Utils;
use base XAO::Objects->load(objname => 'Web::Page');

our $VERSION='2.002';

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

=pod

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)

=cut

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(<
The document is moved here.
EOT
}

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