X-Git-Url: https://git.p6c8.net/devedit.git/blobdiff_plain/162ad0acd3428d54ef3d5d5628e5df6285aa43f5..f3bc7fa5e105cab71c404298ed14ed48caea1bfe:/modules/Tool.pm diff --git a/modules/Tool.pm b/modules/Tool.pm index 1009640..840c134 100644 --- a/modules/Tool.pm +++ b/modules/Tool.pm @@ -6,14 +6,18 @@ package Tool; # Some shared sub routines # # Author: Patrick Canterino -# Last modified: 2004-02-24 +# Last modified: 2004-07-17 # use strict; use vars qw(@EXPORT); -use CGI qw(redirect); +use CGI qw(redirect + escape + virtual_host + https); + use Cwd qw(abs_path); use File::Spec; @@ -113,15 +117,43 @@ sub clean_path($) sub devedit_reload($) { my $params = shift; - my @list; - while(my ($param,$value) = each(%$params)) + # Detect the protocol (simple HTTP or SSL encrypted HTTP) + # and check if the server listens on the default port + + my $protocol = ""; + my $port = ""; + + if(https) { - push(@list,$param."=".$value); + # SSL encrypted HTTP (HTTPS) + + $protocol = "https"; + $port = ":".$ENV{'SERVER_PORT'} if($ENV{'SERVER_PORT'} != 443); } + else + { + # Simple HTTP + + $protocol = "http"; + $port = ":".$ENV{'SERVER_PORT'} if($ENV{'SERVER_PORT'} != 80); + } + + # The following code is grabbed from Template::_query of + # Andre Malo's selfforum (http://sourceforge.net/projects/selfforum/) + # and modified by Patrick Canterino + + my $query = '?'.join ('&' => + map { + (ref) + ? map{escape ($_).'='.escape ($params -> {$_})} @{$params -> {$_}} + : escape ($_).'='.escape ($params -> {$_}) + } keys %$params + ); + + # Create the redirection header - my $query = join("&",@list); - my $header = redirect("http://$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}?$query"); + my $header = redirect($protocol."://".virtual_host.$port.$ENV{'SCRIPT_NAME'}.$query); return \$header; } @@ -149,7 +181,7 @@ sub equal_url($$) # file_name() # -# Return the last path of a path +# Return the last part of a path # # Params: Path #