url relative is its own subroutine now

1 files changed, 84 insertions, 60 deletions

diff --git a/gmi.pl b/gmi.pl
index 15c8b20..9a58b46 100755
--- a/gmi.pl
+++ b/gmi.pl
@@ -10,7 +10,7 @@ use bytes;
 use feature qw(refaliasing);
 no warnings qw(experimental::refaliasing);
 
-our $VERSION = 'v0.0.19';
+our $VERSION = 'v0.0.20';
 
 # TODO: 
 # back() only works once; should fix this
@@ -42,12 +42,17 @@ my %commands = (
 	'url' => [sub { url($_[0],0) }, 'Go to the specified URL.'],
 	'u' => [sub { url($_[0],0) }, 'Alias of `url\''],
 	
-	'urlrelative' => [sub { url($_[0],1) }, "Navigate the current URL relatively.\n\n"
+	'urlrelative' => [sub { urlrelative($_[0]) }, "Navigate the current URL relatively.\n\n"
 		."Note: if the current path is '/blog/my-post1.gmi' and 'my-post2.gmi'\n" .
-		"was supplied then the resulting path will be: 'blog/my-post1.gmi/my-post2.gmi'\n" .
-		"which is probably not what you want; in that case use '../my-post2.gmi'.\n\n" .
-		"The very end of the path is treated like a directory which can be confusing."],
-	'ur' => [sub { url($_[0],1) }, 'Alias of `urlrelative\''],
+		"was supplied then the resulting path will be: '/blog/my-post2.gmi'\n" .
+		"which is probably what you want. You can also use './my-post2.gmi'.\n" .
+		"'.', of course, means 'same directory', in this case '/blog/'.\n\n" .
+		"To remove the forward slash ('/') at the end of the current url,\n" . 
+		"type the back-slash ('\\') by itself.\n\n" .
+		"urlrelative without an argument will remove the ending '/' or go\n" .
+		"up a directory without appending a forward slash.\n" .
+		"IE: '/blog/drafts/secret/post.gmi -> '/blog/drafts/secret' -> '/blog/drafts'"],
+	'ur' => [sub { urlrelative($_[0]) }, 'Alias of `urlrelative\''],
 
 	'cwu' => [sub { print "$current_url\n"; }, 'Returns the current working URL.'],
 	'c' => [sub { print "$current_url\n"; }, 'Alias of `cwu\'.'],
@@ -142,64 +147,14 @@ sub help {
 }
 
 sub url {
-	# technically 'gemini://john/blog/thing.gmi' can be a valid url
-	# where 'john' is the host
-	# which makes determining relative movements a pain
-	#
-	# mode 0 = 'john' can be a host, 1 = 'john' is actually relative movement
-	my ($url, $mode) = @_;
+	my ($url) = @_;
 	### $url
 	if (!$url) { print("Example: [gemini://]capsule.com/\n"); return 1;}
-	if ($url eq '/') {
-		$url = './';
-	}
 	if ( $url !~ m|^.*://.*|) {
 		$url = "gemini://$url";
 	}
+	 
 	$url = parse_url($url);
-	# ## $url
-	my $need_slash;
-	
-	# relative movement
-	if ($mode and $mode eq 1) {
-		if (!$current_url) {print "Relative movement impossible: no current URL.\n"; return 1;}
-		my $c_url = parse_url($current_url);
-
-		#if ($url->{host} and $url->{host} eq '.') { # './' or '/'
-		#	$need_slash = 1;
-		#}
-
-		### $url
-		### $need_slash
-		if ($url->{path}) {
-			$url->{path} = "$url->{host}/$url->{path}";
-		}
-		else {
-			delete($url->{path}); # DO NOT DELETE THIS LINE (P)
-			$url->{path} = "$url->{host}"; 
-		}
-		$url->{host} = $c_url->{host};
-		$url->{port} = $c_url->{port};
-
-
-		my $cp_url;
-		if ($c_url->{path}) {
-			$cp_url = split_url_path($c_url->{path}, 256);
-		}
-		else {
-			$cp_url = [''];
-		}
-		$c_url->{path} = '';
-
-		for (@$cp_url) {
-			$c_url->{path} .= "$_/"
-		}
-
-		$c_url->{path} = "/$c_url->{path}/$url->{path}"; # adding first / for normalize_path
-		$c_url->{path} = normalize_path($c_url->{path});
-		substr($c_url->{path}, 0, 1, ''); # removing the first /
-		$url->{path} = $c_url->{path};
-	}
 
 	### $url
 	if (! $url->{port} or $url->{port} eq 0) {
@@ -212,7 +167,7 @@ sub url {
 	
 		SSL_verify_mode => SSL_VERIFY_NONE,
 		SSL_version => '!SSLv2:!SSLv3:!TLSv1:!TLSv1_1',
-	); 
+	);
 
 	if ($cl) {
 		my $path;
@@ -222,7 +177,7 @@ sub url {
 		else {
 			$path = normalize_path("$url->{path}");
 		}
-		$url->{path} .= "/" if ($need_slash);
+		#$url->{path} .= "/" if ($need_slash);
 		
 		$current_url = return_url($url);
 		### $current_url
@@ -252,6 +207,75 @@ sub url {
 	}
 }
 
+sub urlrelative {
+	my ($urlr) = @_;
+	if (!$current_url) {print "Relative movement impossible: no current URL.\n"; return 1;}
+	my $end_with_slash = 1 if ($urlr =~ m|/$|);
+	my $dot_only = 1 if ($urlr =~ m|^\.$|);
+	my $dot_2_only = 1 if ($urlr =~ m|^\.\.$|); # since we are going up into a dir
+	my $c_url_directory = 1 if ($current_url =~ m|/$|);
+	my $remove_slash = 1 if ($urlr =~ m|^\\$|);  # back slash \ not a forward slash /
+
+	### is urlr a slash only ?
+	if ($urlr =~ m|^/$|) { # if slash only
+		$current_url .= "/";
+		url("$current_url");
+		return 0;
+	}
+
+	### remove slash ?
+	if ($remove_slash) {
+		substr($current_url,-1,1,'');
+		### $current_url
+		url($current_url);
+		return 0;
+	}
+
+	### is the current url a directory?
+	if ($c_url_directory) {
+		$current_url .= "$urlr";
+		my $c_p_url = parse_url($current_url);
+		### $c_p_url
+		# if $urlr has '..' then normalize_path will not go beyond the last element
+		# which is why prefixing a '/' and then taking it away (parse_url doesnt have
+		# the forward / ) will result in expected behavior as host always end with '/'
+		$c_p_url->{path} = normalize_path("/" . $c_p_url->{path});
+		if ($end_with_slash or $dot_only or $dot_2_only) {
+			$c_p_url->{path} .= "/"; # normalize path will remove it
+		}
+		substr($c_p_url->{path},0,1,'');
+		url(return_url($c_p_url));
+		return 0;
+	}
+
+	### current url is not a directory, so should be fine to remove last item on path
+	# ^ some servers serve index page on 'dir' rather than 'dir/'  :v annoying
+	# authors using servers like that will notice that the links on index page need to be
+	# carefully managed, because ALL clients (that handle links correctly) *will* mess up. 
+	if (! $c_url_directory) {
+		my $c_p_url = parse_url($current_url);
+		### $c_p_url
+		my $c_paths_url = split_url_path($c_p_url->{path}, 256);
+		### $c_paths_url
+		pop(@$c_paths_url);
+		### $c_paths_url
+		delete ($c_p_url->{path});
+		for (@$c_paths_url) {
+			$c_p_url->{path} .= "$_/";
+		}
+		### $c_p_url
+		$c_p_url->{path} .= "$urlr";
+		$c_p_url->{path} = normalize_path("/" . "$c_p_url->{path}");
+		if ($end_with_slash or $dot_only or $dot_2_only) {
+			$c_p_url->{path} .= "/"; # normalize path will remove it
+		}
+		substr($c_p_url->{path},0,1,'');
+		### $c_p_url
+		url(return_url($c_p_url));
+		return 0;
+	}
+}
+
 sub return_url {
 	my ($url) = @_;
 	my $url_string;