Skip to content
Permalink
master
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
######################################################################
#
# EPrints::URL
#
######################################################################
#
#
######################################################################
=pod
=for Pod2Wiki
=head1 NAME
B<EPrints::URL> - URL utility methods
=head1 DESCRIPTION
This module contains utility methods for generating and getting URLs, relative paths etc.
=head1 SYNOPSIS
use EPrints;
my $base_url = $session->get_url->get(
scheme => "auto",
host => 1,
path => "cgi",
query => 0,
);
=head1 METHODS
=over 4
=cut
package EPrints::URL;
use warnings;
use strict;
use overload '""' => \&to_string;
sub new
{
my( $class, %opts ) = @_;
bless \%opts, $class;
}
sub to_string
{
my( $self ) = @_;
return $self->get( path => "auto" );
}
=item $url = $url->get( %opts [, $page ] )
Constructs a $url based on the current configuration and %opts. If $page is specified will return a URL to that page.
=over 4
=item scheme => "auto"
Link to same protocol as is active now (N/A to shell scripts).
=item scheme => "http"
Link to the non-secure location.
=item scheme => "https"
Link to the secure location (or http if C<securehost> isn't defined).
=item host => 1
Create an absolute link (including host and port).
=item path => "auto"
Use the current path (N/A to shell scripts).
=item path => "static", path => "cgi", path => "images"
Link to the root of the static, cgi and images respectively.
=item query => 1
Create a self-referential link (i.e. include all parameters in the query part).
=back
=cut
sub get
{
my( $self, @opts ) = @_;
my $page = scalar(@opts) % 2 ? pop(@opts) : undef;
my %opts = @opts;
my $session = $self->{session};
my $uri = URI->new("", "http");
$opts{scheme} = "auto" unless defined $opts{scheme};
$opts{host} = "" unless defined $opts{host};
$opts{path} = "auto" unless defined $opts{path};
# scheme
if( $opts{scheme} eq "auto" )
{
if( $session->get_secure )
{
$opts{scheme} = "https";
}
else
{
$opts{scheme} = "http";
}
}
# host
if( $opts{host} )
{
if( EPrints::Utils::is_set( $session->config( "securehost" ) ) && ( $opts{scheme} eq "https" || !EPrints::Utils::is_set( $session->config( "host" ) ) ) )
{
$uri->scheme( "https" );
$uri->host( $session->config( "securehost" ) );
my $port = $session->config( "secureport" ) || 443;
$uri->port( $port ) if $port != 443;
}
else
{
$uri->scheme( "http" );
my $host = EPrints::Utils::is_set( $session->config( "host" ) ) ? $session->config( "host" ) : $session->config( "securehost" );
$uri->host( $host );
my $port = $session->config( "port" ) || 80;
$uri->port( $port ) if $port != 80;
}
}
# path
if( $opts{path} eq "auto" )
{
if( !defined $session->get_request )
{
EPrints::abort( "Attempt to use CGI path in non-CGI environment" );
}
$uri->path( $session->get_request->uri );
}
elsif( $opts{path} eq "static" )
{
$uri->path( $session->config( "$opts{scheme}_root" ) );
}
elsif( $opts{path} eq "cgi" )
{
$uri->path( $session->config( "$opts{scheme}_cgiroot" ) );
}
elsif( $opts{path} eq "images" )
{
$uri->path( $session->config( "$opts{scheme}_root" ) . "/style/images" );
}
# query
if( $opts{path} && $opts{query} )
{
my @params;
foreach my $param ($session->param)
{
foreach my $value ($session->param( $param ))
{
next if ref($value); # e.g. file handle
push @params, $param => Encode::encode_utf8( $value );
}
}
$uri->query_form( @params );
}
if( $opts{path} && defined($page) )
{
$uri->path( $uri->path . "/" . $page );
}
return $uri;
}
######################################################################
=pod
=back
=cut
######################################################################
1; # For use/require success
=head1 COPYRIGHT
=for COPYRIGHT BEGIN
Copyright 2022 University of Southampton.
EPrints 3.4 is supplied by EPrints Services.
http://www.eprints.org/eprints-3.4/
=for COPYRIGHT END
=for LICENSE BEGIN
This file is part of EPrints 3.4 L<http://www.eprints.org/>.
EPrints 3.4 and this file are released under the terms of the
GNU Lesser General Public License version 3 as published by
the Free Software Foundation unless otherwise stated.
EPrints 3.4 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with EPrints 3.4.
If not, see L<http://www.gnu.org/licenses/>.
=for LICENSE END