Bug 23630: (QA follow-up) Fix tests
[koha.git] / Koha / Util / Navigation.pm
blob57b0d9dfae56fef9f3e6a59923d17e3d6313fe5a
1 package Koha::Util::Navigation;
3 # Copyright Rijksmuseum 2018
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 use Modern::Perl;
21 use C4::Context;
23 =head1 NAME
25 Koha::Util
27 =head1 SYNOPSIS
29 use Koha::Util::Navigation;
30 my $cgi = CGI->new;
31 my $referer = Koha::Util::Navigation::local_referer($cgi);
33 =head1 DESCRIPTION
35 Utility class
37 =head1 FUNCTIONS
39 =head2 local_referer
41 my $referer = Koha::Util::Navigation::local_referer( $cgi, { fallback => '/', remove_language => 1, staff => 1 });
43 If the referer is a local URI, return local path.
44 Otherwise return fallback.
45 Optional parameters fallback, remove_language and staff. If you do not
46 pass staff, opac is assumed.
48 =cut
50 sub local_referer {
51 my ( $cgi, $params ) = @_;
52 my $referer = $cgi->referer;
53 my $fallback = $params->{fallback} // '/';
54 my $staff = $params->{staff}; # no staff means OPAC
55 return $fallback if !$referer;
57 my $base = C4::Context->preference($staff ? 'staffClientBaseURL' : 'OPACBaseURL');
58 my $rv;
60 # Try ..BaseURL first, otherwise use CGI::url
61 if( $base ) {
62 if( substr($referer, 0, length($base)) eq $base &&
63 $referer =~ /\/cgi-bin\/koha\// )
65 $rv = substr( $referer, length($base) );
66 $rv =~ s/^\///;
67 $rv = '/'.$rv;
69 } else {
70 my $cgibase = $cgi->url( -base => 1 );
71 $cgibase =~ s/^https?://;
72 if( $referer =~ /$cgibase(\/cgi-bin\/koha\/.*)$/ ) {
73 $rv = $1;
76 $rv =~ s/(?<=[?&])language=[\w-]+(&|$)// if $rv and $params->{remove_language};
77 return $rv // $fallback;
82 =head1 AUTHOR
84 Marcel de Rooy, Rijksmuseum Amsterdam, The Netherlands
85 Koha development team
87 =cut